131 files changed, 82315 insertions, 162345 deletions

diff --git a/generic/README b/generic/README
index d1c078e..ec6139a 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, and MacOSX).  Platform-specific
-sources are in the directories ../unix, ../win, and ../macosx.
+where Tcl runs (e.g. UNIX, PCs, and Macintoshes).  Platform-specific
+sources are in the directories ../unix, ../win, ../macosx, and ../mac.
diff --git a/generic/regc_color.c b/generic/regc_color.c
index b7a571c..f6716be 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,712 +28,662 @@
  * 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(struct vars *, struct colormap *);
  */
-static void
-initcm(
-    struct vars *v,
-    struct colormap *cm)
+static VOID
+initcm(v, cm)
+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(struct colormap *);
  */
-static void
-freecm(
-    struct colormap *cm)
+static VOID
+freecm(cm)
+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(struct colormap *, union tree *, int);
  */
-static void
-cmtreefree(
-    struct colormap *cm,
-    union tree *tree,
-    int level)			/* level number (top == 0) of this block */
+static VOID
+cmtreefree(cm, tree, level)
+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(
-    struct colormap *cm,
-    pchr c,
-    pcolor co)
+setcolor(cm, c, co)
+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) {
-	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);
+	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;
-	    }
-	    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;
+
+	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;
+		}
 	}
-    }
 
-    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(
-    struct colormap *cm)
+maxcolor(cm)
+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(
-    struct colormap *cm)
+newcolor(cm)
+struct colormap *cm;
 {
-    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));
-	    }
+	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];
 	} else {
-	    newCd = (struct colordesc *)
-		    REALLOC(cm->cd, n * sizeof(struct colordesc));
-	}
-	if (newCd == NULL) {
-	    CERR(REG_ESPACE);
-	    return COLORLESS;
+		/* 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];
 	}
-	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);
+
+	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(struct colormap *, pcolor);
  */
-static void
-freecolor(
-    struct colormap *cm,
-    pcolor co)
+static VOID
+freecolor(cm, co)
+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 */
-    }
-
-    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;
+	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 (cm->free > 0) {
-	    assert((size_t)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((size_t)nco < cm->max);
-		    pco = nco;
-		    nco = cm->cd[pco].sub;
+
+	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;
+				}
 		}
-	    }
+	} 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(
-    struct colormap *cm)
+pseudocolor(cm)
+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(
-    struct colormap *cm,
-    pchr c)
+subcolor(cm, c)
+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(
-    struct colormap *cm,
-    pcolor co)
+newsub(cm, co)
+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;
+	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 */
 	}
-	cm->cd[co].sub = sco;
-	cm->cd[sco].sub = sco;	/* open subcolor points to self */
-    }
-    assert(sco != NOSUB);
+	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 *,
+ ^ static VOID subrange(struct vars *, pchr, pchr, struct state *,
  ^ 	struct state *);
  */
-static void
-subrange(
-    struct vars *v,
-    pchr from,
-    pchr to,
-    struct state *lp,
-    struct state *rp)
+static VOID
+subrange(v, from, to, lp, rp)
+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(struct vars *, pchr, struct state *, struct state *);
  */
-static void
-subblock(
-    struct vars *v,
-    pchr start,			/* first of BYTTAB chrs */
-    struct state *lp,
-    struct state *rp)
+static VOID
+subblock(v, start, lp, rp)
+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(t->tptr, 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(VS(t->tptr), VS(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.
-	 */
 
-	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);
+	/* 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;
 		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;
-	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;
-    }
+	/* 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(struct nfa *, struct colormap *);
  */
-static void
-okcolors(
-    struct nfa *nfa,
-    struct colormap *cm)
+static VOID
+okcolors(nfa, cm)
+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(struct colormap *, struct arc *);
  */
-static void
-colorchain(
-    struct colormap *cm,
-    struct arc *a)
+static VOID
+colorchain(cm, a)
+struct colormap *cm;
+struct arc *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;
+	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;
 }
-
+
 /*
  - uncolorchain - delete this arc from the color chain of its color
- ^ static void uncolorchain(struct colormap *, struct arc *);
+ ^ 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 void
-uncolorchain(
-    struct colormap *cm,
-    struct arc *a)
+static int			/* predicate */
+singleton(cm, c)
+struct colormap *cm;
+pchr c;
 {
-    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;
+	color co;			/* color of c */
+
+	co = GETCOLOR(cm, c);
+	if (cm->cd[co].nchrs == 1 && cm->cd[co].sub == NOSUB)
+		return 1;
+	return 0;
 }
-
+
 /*
  - rainbow - add arcs of all full colors (but one) between specified states
- ^ static void rainbow(struct nfa *, struct colormap *, int, pcolor,
+ ^ static VOID rainbow(struct nfa *, struct colormap *, int, pcolor,
  ^ 	struct state *, struct state *);
  */
-static void
-rainbow(
-    struct nfa *nfa,
-    struct colormap *cm,
-    int type,
-    pcolor but,			/* COLORLESS if no exceptions */
-    struct state *from,
-    struct state *to)
+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;
 {
-    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,
+ ^ static VOID colorcomplement(struct nfa *, struct colormap *, int,
  ^ 	struct state *, struct state *, struct state *);
  */
-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)
+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;
 {
-    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
@@ -741,108 +691,89 @@ colorcomplement(
 
 /*
  - dumpcolors - debugging output
- ^ static void dumpcolors(struct colormap *, FILE *);
+ ^ static VOID dumpcolors(struct colormap *, FILE *);
  */
-static void
-dumpcolors(
-    struct colormap *cm,
-    FILE *f)
+static VOID
+dumpcolors(cm, f)
+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);
+	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");
 		}
-	    }
-	    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(struct colormap *, union tree *, int, FILE *);
  */
-static void
-fillcheck(
-    struct colormap *cm,
-    union tree *tree,
-    int level,			/* level number (top == 0) of this block */
-    FILE *f)
+static VOID
+fillcheck(cm, tree, level, f)
+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) {
-	    /* empty body */
-	} 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)
+			{}
+		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(pchr, FILE *);
  */
-static void
-dumpchr(
-    pchr c,
-    FILE *f)
+static VOID
+dumpchr(c, f)
+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 0247521..0b976b8 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,120 +27,149 @@
  * 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);
+ ^ static struct cvec *newcvec(int, int, int);
  */
 static struct cvec *
-newcvec(
-    int nchrs,			/* to hold this many chrs... */
-    int nranges)		/* ... and this many ranges... */
+newcvec(nchrs, nranges, nmcces)
+    int nchrs;				/* to hold this many chrs... */
+    int nranges;			/* ... and this many ranges... */
+    int nmcces;				/* ... and this many MCCEs */
 {
-    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);
+    size_t n;
+    size_t nc;
+    struct cvec *cv;
 
+    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 *)(((char *)cv)+sizeof(struct cvec));
-    cv->ranges = cv->chrs + nchrs;
+    cv->chrs = (chr *)&cv->mcces[nmcces];	/* chrs just after MCCE ptrs */
+    cv->mccespace = nmcces;
+    cv->ranges = cv->chrs + nchrs + nmcces*(MAXMCCE+1);
     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(
-    struct cvec *cv)		/* character vector */
+clearcvec(cv)
+    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(struct cvec *, pchr);
  */
-static void
-addchr(
-    struct cvec *cv,		/* character vector */
-    pchr c)			/* character to add */
+static VOID
+addchr(cv, c)
+    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(struct cvec *, pchr, pchr);
  */
-static void
-addrange(
-    struct cvec *cv,		/* character vector */
-    pchr from,			/* first character of range */
-    pchr to)			/* last character of range */
+static VOID
+addrange(cv, from, to)
+    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(
-    struct vars *v,		/* context */
-    int nchrs,			/* to hold this many chrs... */
-    int nranges)		/* ... and this many ranges... */
+getcvec(v, nchrs, nranges)
+    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);
+    v->cv = newcvec(nchrs, nranges, 0);
     if (v->cv == NULL) {
 	ERR(REG_ESPACE);
     }
 
     return v->cv;
 }
-
+
 /*
  - freecvec - free a cvec
- ^ static void freecvec(struct cvec *);
+ ^ static VOID freecvec(struct cvec *);
  */
-static void
-freecvec(
-    struct cvec *cv)		/* character vector */
+static VOID
+freecvec(cv)
+    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 132e757..99497b9 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,6 +27,7 @@
  * 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) */
@@ -34,10 +35,9 @@
 #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,922 +60,804 @@
 
 /* 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(struct vars *);
  */
-static void
-lexstart(
-    struct vars *v)
+static VOID
+lexstart(v)
+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(struct vars *);
  */
-static void
-prefixes(
-    struct vars *v)
+static VOID
+prefixes(v)
+struct vars *v;
 {
-    /*
-     * Literal string doesn't get any of this stuff.
-     */
-
-    if (v->cflags&REG_QUOTE) {
-	return;
-    }
-
-    /*
-     * 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;
-	}
-    }
-
-    /*
-     * BREs and EREs don't get embedded options.
-     */
-
-    if ((v->cflags&REG_ADVANCED) != REG_ADVANCED) {
-	return;
-    }
+	/* literal string doesn't get any of this stuff */
+	if (v->cflags&REG_QUOTE)
+		return;
 
-    /*
-     * Embedded options (AREs only).
-     */
+	/* 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 (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);
+	/* BREs and EREs don't get embedded options */
+	if ((v->cflags&REG_ADVANCED) != REG_ADVANCED)
 		return;
-	    }
-	}
-	if (!NEXT1(')')) {
-	    ERR(REG_BADOPT);
-	    return;
-	}
-	v->now++;
-	if (v->cflags&REG_QUOTE) {
-	    v->cflags &= ~(REG_EXPANDED|REG_NEWLINE);
+
+	/* 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 *, const chr *, const chr *);
+ ^ static VOID lexnest(struct vars *, chr *, chr *);
  */
-static void
-lexnest(
-    struct vars *v,
-    const chr *beginp,		/* start of interpolation */
-    const chr *endp)		/* one past end of interpolation */
+static VOID
+lexnest(v, beginp, endp)
+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(struct vars *);
  */
-static void
-lexword(
-    struct vars *v)
+static VOID
+lexword(v)
+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(
-    struct vars *v)
+next(v)
+struct vars *v;
 {
-    chr c;
-
-    /*
-     * Errors yield an infinite sequence of failures.
-     */
-
-    if (ISERR()) {
-	return 0;		/* the error has set nexttype to EOS */
-    }
+	chr c;
 
-    /*
-     * Remember flavor of last token.
-     */
+	/* errors yield an infinite sequence of failures */
+	if (ISERR())
+		return 0;	/* the error has set nexttype to EOS */
 
-    v->lasttype = v->nexttype;
+	/* remember flavor of last token */
+	v->lasttype = v->nexttype;
 
-    /*
-     * REG_BOSONLY
-     */
-
-    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;
+	/* REG_BOSONLY */
+	if (v->nexttype == EMPTY && (v->cflags&REG_BOSONLY)) {
+		/* at start of a REG_BOSONLY RE */
+		RETV(SBEGIN, 0);		/* same as \A */
 	}
-    }
 
-    /*
-     * 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;
+	/* 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;
 	}
-	assert(NOTREACHED);
-    }
-
-    /*
-     * Okay, time to actually get a character.
-     */
 
-    c = *v->now++;
-
-    /*
-     * Deal with the easy contexts, punt EREs to code below.
-     */
+	/* 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;
+		}
 
-    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('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);
+	/* 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;
 		}
-		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);
 	}
-	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)) {
+
+	/* okay, time to actually get a character */
+	c = *v->now++;
+
+	/* deal with the easy contexts, punt EREs to code below */
+	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);
-	    }
-	    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;
+	case L_BBND:			/* bounds are fairly simple */
+	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_EESCAPE);
-		    break;
+			FAILW(REG_BADBR);
+			break;
 		}
-
-		/*
-		 * lexnest() done, back up and try again.
-		 */
-
-		v->nexttype = v->lasttype;
-		return next(v);
+		assert(NOTREACHED);
 		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);
+	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 CHR('='):
-		INTOCON(L_ECL);
-		NOTE(REG_ULOCALE);
-		RET(ECLASS);
+	case L_CEL:			/* collating elements are easy */
+		if (c == CHR('.') && NEXT1(']')) {
+			v->now++;
+			INTOCON(L_BRACK);
+			RETV(END, '.');
+		} else
+			RETV(PLAIN, c);
 		break;
-	    case CHR(':'):
-		INTOCON(L_CCL);
-		NOTE(REG_ULOCALE);
-		RET(CCLASS);
+	case L_ECL:			/* ditto equivalence classes */
+		if (c == CHR('=') && NEXT1(']')) {
+			v->now++;
+			INTOCON(L_BRACK);
+			RETV(END, '=');
+		} else
+			RETV(PLAIN, c);
 		break;
-	    default:		/* oops */
-		v->now--;
-		RETV(PLAIN, c);
+	case L_CCL:			/* ditto character classes */
+		if (c == CHR(':') && NEXT1(']')) {
+			v->now++;
+			INTOCON(L_BRACK);
+			RETV(END, ':');
+		} else
+			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);
+		assert(NOTREACHED);
+		break;
 	}
-	break;
-    default:
-	assert(NOTREACHED);
-	break;
-    }
 
-    /*
-     * That got rid of everything except EREs and AREs.
-     */
+	/* that got rid of everything except EREs and AREs */
+	assert(INCON(L_ERE));
 
-    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);
+	/* deal with EREs and AREs, except for backslashes */
+	switch (c) {
+	case CHR('|'):
+		RET('|');
 		break;
-	    case CHR('#'):	/* comment */
-		while (!ATEOS() && *v->now != CHR(')')) {
-		    v->now++;
+	case CHR('*'):
+		if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+			v->now++;
+			NOTE(REG_UNONPOSIX);
+			RETV('*', 0);
 		}
-		if (!ATEOS()) {
-		    v->now++;
+		RETV('*', 1);
+		break;
+	case CHR('+'):
+		if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+			v->now++;
+			NOTE(REG_UNONPOSIX);
+			RETV('+', 0);
 		}
-		assert(v->nexttype == v->lasttype);
-		return next(v);
+		RETV('+', 1);
 		break;
-	    case CHR('='):	/* positive lookahead */
-		NOTE(REG_ULOOKAHEAD);
-		RETV(LACON, 1);
+	case CHR('?'):
+		if ((v->cflags&REG_ADVF) && NEXT1('?')) {
+			v->now++;
+			NOTE(REG_UNONPOSIX);
+			RETV('?', 0);
+		}
+		RETV('?', 1);
 		break;
-	    case CHR('!'):	/* negative lookahead */
-		NOTE(REG_ULOOKAHEAD);
-		RETV(LACON, 0);
+	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;
-	    default:
-		FAILW(REG_BADRPT);
+	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);
+		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;
-	    }
-	    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);
+	/* 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++);
 	}
-	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;
+	(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);
 	}
-	/* lexnest done, back up and try again */
-	v->nexttype = v->lasttype;
-	return next(v);
-    }
-
-    /*
-     * Otherwise, lexescape has already done the work.
-     */
-
-    return !ISERR();
+	/* 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(
-    struct vars *v)
+lexescape(v)
+struct vars *v;
 {
-    chr c;
-    int i;
-    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);
-    }
-
-    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 = (uchr) lexdigits(v, 16, 1, 4);
-	if (ISERR()) {
-	    FAILW(REG_EESCAPE);
-	}
-	RETV(PLAIN, c);
-	break;
-    case CHR('U'):
-	i = lexdigits(v, 16, 1, 8);
-	if (ISERR()) {
-	    FAILW(REG_EESCAPE);
-	}
-	if (i > 0xFFFF) {
-	    /* TODO: output a Surrogate pair
-	     */
-	    i = 0xFFFD;
-	}
-	RETV(PLAIN, (uchr) i);
-	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 = (uchr) lexdigits(v, 16, 1, 2);
-	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 = (uchr) 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.
-	 */
+	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);
 
-    case CHR('0'):
-	NOTE(REG_UUNPORT);
-	v->now--;		/* put first digit back */
-	c = (uchr) lexdigits(v, 8, 1, 3);
-	if (ISERR()) {
-	    FAILW(REG_EESCAPE);
-	}
-	if (c > 0xff) {
-	    /* out of range, so we handled one digit too much */
-	    v->now--;
-	    c >>= 3;
+	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;
 	}
-	RETV(PLAIN, c);
-	break;
-    default:
-	assert(iscalpha(c));
-	FAILW(REG_EESCAPE);	/* unknown alphabetic escape */
-	break;
-    }
-    assert(NOTREACHED);
+	assert(NOTREACHED);
 }
-
+
 /*
  - lexdigits - slurp up digits and return chr value
- ^ static int lexdigits(struct vars *, int, int, int);
+ ^ static chr lexdigits(struct vars *, int, int, int);
  */
-static int			/* chr value; errors signalled via ERR */
-lexdigits(
-    struct vars *v,
-    int base,
-    int minlen,
-    int maxlen)
+static chr			/* chr value; errors signalled via ERR */
+lexdigits(v, base, minlen, maxlen)
+struct vars *v;
+int base;
+int minlen;
+int maxlen;
 {
-    int n;
-    int len;
-    chr c;
-    int d;
-    const uchr ub = (uchr) base;
-
-    n = 0;
-    for (len = 0; len < maxlen && !ATEOS(); len++) {
-	if (n > 0x10fff) {
-	    /* Stop when continuing would otherwise overflow */
-	    break;
-	}
-	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;
+
+	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 (d >= base) {	/* not a plausible digit */
-	    v->now--;
-	    d = -1;
-	}
-	if (d < 0) {
-	    break;		/* NOTE BREAK OUT */
+		if (d >= base) {	/* not a plausible digit */
+			v->now--;
+			d = -1;
+		}
+		if (d < 0)
+			break;		/* NOTE BREAK OUT */
+		n = n*ub + (uchr)d;
 	}
-	n = n*ub + (uchr)d;
-    }
-    if (len < minlen) {
-	ERR(REG_EESCAPE);
-    }
+	if (len < minlen)
+		ERR(REG_EESCAPE);
 
-    return n;
+	return (chr)n;
 }
-
+
 /*
  - brenext - get next BRE token
  * This is much like EREs except for all the stupid backslashes and the
@@ -983,218 +865,197 @@ lexdigits(
  ^ static int brenext(struct vars *, pchr);
  */
 static int			/* 1 normal, 0 failure */
-brenext(
-    struct vars *v,
-    pchr pc)
+brenext(v, pc)
+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('$');
+	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;
 	}
-	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);
+	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;
 	}
-	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(struct vars *);
  */
-static void
-skip(
-    struct vars *v)
+static VOID
+skip(v)
+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++;
+	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 */
 	}
 
-	/*
-	 * Leave the newline to be picked up by the iscspace loop.
-	 */
-    }
-
-    if (v->now != start) {
-	NOTE(REG_UNONPOSIX);
-    }
+	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(void)
+newline()
 {
-    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 const chr *ch(NOPARMS);
+ ^ static chr *ch(NOPARMS);
  ^ #endif
  */
 #ifdef REG_DEBUG
-static const chr *
-ch(void)
+static CONST chr *
+ch()
 {
-    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 *, const chr *, const chr *, pchr);
+ ^ static chr chrnamed(struct vars *, chr *, chr *, pchr);
  */
 static chr
-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 */
+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 */
 {
-    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 188d6de..6c421d7 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(
-    struct vars *v,		/* context */
-    const chr *startp,		/* points to start of name */
-    const chr *endp)		/* points just past end of name */
+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 */
 {
-    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(
  ^ static struct cvec *range(struct vars *, celt, celt, int);
  */
 static struct cvec *
-range(
-    struct vars *v,		/* context */
-    celt a,			/* range start */
-    celt b,			/* range end, might equal a */
-    int cases)			/* case-independent? */
+range(v, a, b, cases)
+    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(
  ^ static int before(celt, celt);
  */
 static int			/* predicate */
-before(
-    celt x, celt y)		/* collating elements */
+before(x, y)
+    celt x, y;				/* collating elements */
 {
     if (x < y) {
 	return 1;
@@ -841,11 +841,11 @@ before(
  ^ static struct cvec *eclass(struct vars *, celt, int);
  */
 static struct cvec *
-eclass(
-    struct vars *v,		/* context */
-    celt c,			/* Collating element representing the
-				 * equivalence class. */
-    int cases)			/* all cases? */
+eclass(v, c, cases)
+    struct vars *v;			/* context */
+    celt c;				/* Collating element representing
+					 * the equivalence class. */
+    int cases;				/* all cases? */
 {
     struct cvec *cv;
 
@@ -880,27 +880,27 @@ eclass(
 /*
  - 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(
-    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(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? */
 {
     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(
  ^ static struct cvec *allcases(struct vars *, pchr);
  */
 static struct cvec *
-allcases(
-    struct vars *v,		/* context */
-    pchr pc)			/* character to get case equivs of */
+allcases(v, pc)
+    struct vars *v;			/* context */
+    pchr pc;				/* character to get case equivs of */
 {
     struct cvec *cv;
     chr c = (chr)pc;
@@ -1150,12 +1150,12 @@ allcases(
  * 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(
-    const chr *x, const chr *y,	/* strings to compare */
-    size_t len)			/* exact length of comparison */
+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 */
 {
     return memcmp(VS(x), VS(y), len*sizeof(chr));
 }
@@ -1166,12 +1166,12 @@ cmp(
  * 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(
-    const chr *x, const chr *y,	/* strings to compare */
-    size_t len)			/* exact length of comparison */
+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 */
 {
     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 4fb3ea6..48f56a9 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,888 +28,814 @@
  * 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(
-    struct vars *v,
-    struct colormap *cm,
-    struct nfa *parent)		/* NULL if primary NFA */
+newnfa(v, cm, parent)
+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;	/* 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;
+	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;
 }
-
+
 /*
- - TooManyStates - checks if the max states exceeds the compile-time value
- ^ static int TooManyStates(struct nfa *);
+ - too_many_states - checks if the max states exceeds the compile-time value
+ ^ static int too_many_states(struct nfa *);
  */
 static int
-TooManyStates(
-    struct nfa *nfa)
+too_many_states(nfa)
+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;
 }
-
+
 /*
- - IncrementSize - increases the tracked size of the NFA and its parents.
- ^ static void IncrementSize(struct nfa *);
+ - increment_size - increases the tracked size of the NFA and its parents.
+ ^ static void increment_size(struct nfa *);
  */
 static void
-IncrementSize(
-    struct nfa *nfa)
+increment_size(nfa)
+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;
+	}
 }
-
+
 /*
- - DecrementSize - increases the tracked size of the NFA and its parents.
- ^ static void DecrementSize(struct nfa *);
+ - decrement_size - increases the tracked size of the NFA and its parents.
+ ^ static void decrement_size(struct nfa *);
  */
 static void
-DecrementSize(
-    struct nfa *nfa)
+decrement_size(nfa)
+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(struct nfa *);
  */
-static void
-freenfa(
-    struct nfa *nfa)
+static VOID
+freenfa(nfa)
+struct nfa *nfa;
 {
-    struct state *s;
+	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);
-    }
-
-    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(
-    struct nfa *nfa)
+newstate(nfa)
+struct nfa *nfa;
 {
-    struct state *s;
+	struct state *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;
+	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;
 	}
-	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;
+	s->prev = nfa->slast;
+	nfa->slast = s;
+	/* Track the current size and the parent size */
+	increment_size(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(
-    struct nfa *nfa,
-    int flag)
+newfstate(nfa, flag)
+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(struct nfa *, struct state *);
  */
-static void
-dropstate(
-    struct nfa *nfa,
-    struct state *s)
+static VOID
+dropstate(nfa, s)
+struct nfa *nfa;
+struct state *s;
 {
-    struct arc *a;
+	struct arc *a;
 
-    while ((a = s->ins) != NULL) {
-	freearc(nfa, a);
-    }
-    while ((a = s->outs) != NULL) {
-	freearc(nfa, a);
-    }
-    freestate(nfa, s);
+	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(struct nfa *, struct state *);
  */
-static void
-freestate(
-    struct nfa *nfa,
-    struct state *s)
+static VOID
+freestate(nfa, s)
+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;
-    DecrementSize(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;
+	decrement_size(nfa);
 }
-
+
 /*
  - destroystate - really get rid of an already-freed state
- ^ static void destroystate(struct nfa *, struct state *);
+ ^ static VOID destroystate(struct nfa *, struct state *);
  */
-static void
-destroystate(
-    struct nfa *nfa,
-    struct state *s)
+static VOID
+destroystate(nfa, s)
+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(
-    struct nfa *nfa,
-    int t,
-    pcolor co,
-    struct state *from,
-    struct state *to)
+static VOID
+newarc(nfa, t, co, from, to)
+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.
-     */
+	/* check for duplicates */
+	for (a = from->outs; a != NULL; a = a->outchain)
+		if (a->to == to && a->co == co && a->type == t)
+			return;
 
-    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);
 
-    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(
-    struct nfa *nfa,
-    struct state *s)
+allocarc(nfa, s)
+struct nfa *nfa;
+struct state *s;
 {
-    struct arc *a;
-
-    /*
-     * Shortcut
-     */
-
-    if (s->free == NULL && s->noas < ABSIZE) {
-	a = &s->oas.a[s->noas];
-	s->noas++;
-	return a;
-    }
-
-    /*
-     * if none at hand, get more
-     */
-
-    if (s->free == NULL) {
-	struct arcbatch *newAb = (struct arcbatch *)
-		MALLOC(sizeof(struct arcbatch));
+	struct arc *a;
+	struct arcbatch *new;
 	int i;
 
-	if (newAb == NULL) {
-	    NERR(REG_ESPACE);
-	    return NULL;
+	/* shortcut */
+	if (s->free == NULL && s->noas < ABSIZE) {
+		a = &s->oas.a[s->noas];
+		s->noas++;
+		return a;
 	}
-	newAb->next = s->oas.next;
-	s->oas.next = newAb;
 
-	for (i=0 ; i<ABSIZE ; i++) {
-	    newAb->a[i].type = 0;
-	    newAb->a[i].freechain = &newAb->a[i+1];
+	/* 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;
+
+		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];
 	}
-	newAb->a[ABSIZE-1].freechain = NULL;
-	s->free = &newAb->a[0];
-    }
-    assert(s->free != NULL);
-
-    a = s->free;
-    s->free = a->freechain;
-    return a;
+	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(struct nfa *, struct arc *);
  */
-static void
-freearc(
-    struct nfa *nfa,
-    struct arc *victim)
+static VOID
+freearc(nfa, victim)
+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;
+	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;
 	}
-	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;
+	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;
 	}
-	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;
+	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(
-    struct state *s,
-    int type,
-    pcolor co)
+findarc(s, type, co)
+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(
-    struct nfa *nfa,
-    struct arc *oa,
-    struct state *from,
-    struct state *to)
+static VOID
+cparc(nfa, oa, from, to)
+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
  * existing arcs, and you would be right if it weren't for the desire
  * for duplicate suppression, which makes it easier to just make new
  * ones to exploit the suppression built into newarc.
- ^ static void moveins(struct nfa *, struct state *, struct state *);
+ ^ static VOID moveins(struct nfa *, struct state *, struct state *);
  */
-static void
-moveins(
-    struct nfa *nfa,
-    struct state *oldState,
-    struct state *newState)
+static VOID
+moveins(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
 {
-    struct arc *a;
+	struct arc *a;
 
-    assert(oldState != newState);
+	assert(old != new);
 
-    while ((a = oldState->ins) != NULL) {
-	cparc(nfa, a, a->from, newState);
-	freearc(nfa, a);
-    }
-    assert(oldState->nins == 0);
-    assert(oldState->ins == NULL);
+	while ((a = old->ins) != NULL) {
+		cparc(nfa, a, a->from, new);
+		freearc(nfa, a);
+	}
+	assert(old->nins == 0);
+	assert(old->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(struct nfa *, struct state *, struct state *);
  */
-static void
-copyins(
-    struct nfa *nfa,
-    struct state *oldState,
-    struct state *newState)
+static VOID
+copyins(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
 {
-    struct arc *a;
+	struct arc *a;
 
-    assert(oldState != newState);
+	assert(old != new);
 
-    for (a=oldState->ins ; a!=NULL ; a=a->inchain) {
-	cparc(nfa, a, a->from, newState);
-    }
+	for (a = old->ins; a != NULL; a = a->inchain)
+		cparc(nfa, a, a->from, new);
 }
-
+
 /*
  - moveouts - move all out arcs of a state to another state
- ^ static void moveouts(struct nfa *, struct state *, struct state *);
+ ^ static VOID moveouts(struct nfa *, struct state *, struct state *);
  */
-static void
-moveouts(
-    struct nfa *nfa,
-    struct state *oldState,
-    struct state *newState)
+static VOID
+moveouts(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
 {
-    struct arc *a;
+	struct arc *a;
 
-    assert(oldState != newState);
+	assert(old != new);
 
-    while ((a = oldState->outs) != NULL) {
-	cparc(nfa, a, newState, a->to);
-	freearc(nfa, a);
-    }
+	while ((a = old->outs) != NULL) {
+		cparc(nfa, a, new, 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(struct nfa *, struct state *, struct state *);
  */
-static void
-copyouts(
-    struct nfa *nfa,
-    struct state *oldState,
-    struct state *newState)
+static VOID
+copyouts(nfa, old, new)
+struct nfa *nfa;
+struct state *old;
+struct state *new;
 {
-    struct arc *a;
+	struct arc *a;
 
-    assert(oldState != newState);
+	assert(old != new);
 
-    for (a=oldState->outs ; a!=NULL ; a=a->outchain) {
-	cparc(nfa, a, newState, a->to);
-    }
+	for (a = old->outs; a != NULL; a = a->outchain)
+		cparc(nfa, a, new, a->to);
 }
-
+
 /*
  - cloneouts - copy out arcs of a state to another state pair, modifying type
- ^ static void cloneouts(struct nfa *, struct state *, struct state *,
+ ^ static VOID cloneouts(struct nfa *, struct state *, struct state *,
  ^ 	struct state *, int);
  */
-static void
-cloneouts(
-    struct nfa *nfa,
-    struct state *old,
-    struct state *from,
-    struct state *to,
-    int type)
+static VOID
+cloneouts(nfa, old, from, to, type)
+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(struct nfa *, struct state *, struct state *);
  */
-static void
-delsub(
-    struct nfa *nfa,
-    struct state *lp,		/* the sub-NFA goes from here... */
-    struct state *rp)		/* ...to here, *not* inclusive */
+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 */
 {
-    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(struct nfa *, struct state *, struct state *);
  */
-static void
-deltraverse(
-    struct nfa *nfa,
-    struct state *leftend,
-    struct state *s)
+static VOID
+deltraverse(nfa, leftend, s)
+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(
-    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(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 */
 {
-    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, 0);
-    /* 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(struct nfa *, struct state *, struct state *);
  */
-static void
-duptraverse(
-    struct nfa *nfa,
-    struct state *s,
-    struct state *stmp,		/* s's duplicate, or NULL */
-    int depth)
+static VOID
+duptraverse(nfa, s, stmp)
+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;
-    }
-
-    /*
-     * Arbitrary depth limit. Needs tuning, but this value is sufficient to
-     * make all normal tests (not reg-33.14) pass.
-     */
-#define DUPTRAVERSE_MAX_DEPTH 500
-
-    if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
-	NERR(REG_ESPACE);
-    }
-
-    for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) {
-	duptraverse(nfa, a->to, NULL, depth);
-	if (NISERR()) {
-	    break;
+	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);
 	}
-	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(struct nfa *, struct state *);
  */
-static void
-cleartraverse(
-    struct nfa *nfa,
-    struct state *s)
+static VOID
+cleartraverse(nfa, s)
+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(struct nfa *);
  */
-static void
-specialcolors(
-    struct nfa *nfa)
+static VOID
+specialcolors(nfa)
+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(
-    struct nfa *nfa,
-    FILE *f)			/* for debug output; NULL none */
+optimize(nfa, f)
+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(struct nfa *, FILE *);
  */
-static void
-pullback(
-    struct nfa *nfa,
-    FILE *f)			/* for debug output; NULL none */
+static VOID
+pullback(nfa, f)
+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) {
+	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) {
 		nexta = a->outchain;
-		if (a->type == '^' || a->type == BEHIND) {
-		    if (pull(nfa, a)) {
-			progress = 1;
-		    }
+		if (a->type == '^') {
+			assert(a->co == 0 || a->co == 1);
+			newarc(nfa, PLAIN, nfa->bos[a->co], a->from, a->to);
+			freearc(nfa, a);
 		}
-		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
@@ -918,155 +844,136 @@ pullback(
  ^ static int pull(struct nfa *, struct arc *);
  */
 static int			/* 0 couldn't, 1 could */
-pull(
-    struct nfa *nfa,
-    struct arc *con)
+pull(nfa, con)
+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;
-    }
-
-    /*
-     * 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;
+	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;
 	}
-    }
 
-    /*
-     * First, clone from state if necessary to avoid other outarcs.
-     */
+	/*
+	 * 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.
+	 */
 
-    if (from->nouts > 1) {
-	s = newstate(nfa);
-	if (NISERR()) {
-	    return 0;
+	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;
+		}
 	}
-	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;
+
+	/* 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);
 
-    /*
-     * Remaining inarcs, if any, incorporate the constraint.
-     */
+	/* 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;
+		}
+	}
 
-    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(struct nfa *, FILE *);
  */
-static void
-pushfwd(
-    struct nfa *nfa,
-    FILE *f)			/* for debug output; NULL none */
+static VOID
+pushfwd(nfa, f)
+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) {
+	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) {
 		nexta = a->inchain;
-		if (a->type == '$' || a->type == AHEAD) {
-		    if (push(nfa, a)) {
-			progress = 1;
-		    }
+		if (a->type == '$') {
+			assert(a->co == 0 || a->co == 1);
+			newarc(nfa, PLAIN, nfa->eos[a->co], a->from, a->to);
+			freearc(nfa, a);
 		}
-		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
@@ -1075,106 +982,94 @@ pushfwd(
  ^ static int push(struct nfa *, struct arc *);
  */
 static int			/* 0 couldn't, 1 could */
-push(
-    struct nfa *nfa,
-    struct arc *con)
+push(nfa, con)
+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;
-    }
-
-    /*
-     * 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;
+	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;
 	}
-    }
-    /*
-     * First, clone to state if necessary to avoid other inarcs.
-     */
 
-    if (to->nins > 1) {
-	s = newstate(nfa);
-	if (NISERR()) {
-	    return 0;
+	/*
+	 * 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;
+		}
 	}
-	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;
+
+	/* 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;
 	}
-    }
+	assert(to->nins == 1);
 
-    /*
-     * Remaining outarcs, if any, incorporate the constraint.
-     */
+	/* 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;
+		}
+	}
 
-    moveouts(nfa, to, from);
-    dropstate(nfa, to);		/* will free the constraint */
-    return 1;
+	/* remaining outarcs, if any, incorporate the constraint */
+	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
@@ -1183,450 +1078,397 @@ push(
  ^ static int combine(struct arc *, struct arc *);
  */
 static int
-combine(
-    struct arc *con,
-    struct arc *a)
+combine(con, a)
+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;
+#	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;
 	}
-	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 */
+	assert(NOTREACHED);
+	return INCOMPATIBLE;		/* for benefit of blind compilers */
 }
-
+
 /*
  - fixempties - get rid of EMPTY arcs
- ^ static void fixempties(struct nfa *, FILE *);
+ ^ static VOID fixempties(struct nfa *, FILE *);
  */
-static void
-fixempties(
-    struct nfa *nfa,
-    FILE *f)			/* for debug output; NULL none */
+static VOID
+fixempties(nfa, f)
+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 eliminate empties until there are no more.
-     */
-
-    do {
-	progress = 0;
-	for (s = nfa->states; s != NULL && !NISERR()
-		&& s->no != FREESTATE; s = nexts) {
-	    nexts = s->next;
-	    for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
-		nexta = a->outchain;
-		if (a->type == EMPTY && unempty(nfa, a)) {
-		    progress = 1;
+	struct state *s;
+	struct state *nexts;
+	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->no != FREESTATE; s = nexts) {
+			nexts = s->next;
+			for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
+				nexta = a->outchain;
+				if (a->type == EMPTY && unempty(nfa, a))
+					progress = 1;
+				assert(nexta == NULL || s->no != FREESTATE);
+			}
 		}
-		assert(nexta == NULL || s->no != FREESTATE);
-	    }
-	}
-	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(
-    struct nfa *nfa,
-    struct arc *a)
+unempty(nfa, a)
+struct nfa *nfa;
+struct arc *a;
 {
-    struct state *from = a->from;
-    struct state *to = a->to;
-    int usefrom;		/* work on from, as opposed to to? */
-
-    assert(a->type == EMPTY);
-    assert(from != nfa->pre && to != nfa->post);
+	struct state *from = a->from;
+	struct state *to = a->to;
+	int usefrom;		/* work on from, as opposed to to? */
 
-    if (from == to) {		/* vacuous loop */
-	freearc(nfa, a);
-	return 1;
-    }
-
-    /*
-     * Decide which end to work on.
-     */
+	assert(a->type == EMPTY);
+	assert(from != nfa->pre && to != nfa->post);
 
-    usefrom = 1;		/* default: attack from */
-    if (from->nouts > to->nins) {
-	usefrom = 0;
-    } else if (from->nouts == to->nins) {
-	/*
-	 * Decide on secondary issue: move/copy fewest arcs.
-	 */
-
-	if (from->nins > to->nouts) {
-	    usefrom = 0;
+	if (from == to) {		/* vacuous loop */
+		freearc(nfa, a);
+		return 1;
 	}
-    }
 
-    freearc(nfa, a);
-    if (usefrom) {
-	if (from->nouts == 0) {
-	    /*
-	     * Was the state's only outarc.
-	     */
-
-	    moveins(nfa, from, to);
-	    freestate(nfa, from);
-	} else {
-	    copyins(nfa, from, to);
+	/* decide which end to work on */
+	usefrom = 1;			/* default:  attack from */
+	if (from->nouts > to->nins)
+		usefrom = 0;
+	else if (from->nouts == to->nins) {
+		/* decide on secondary issue:  move/copy fewest arcs */
+		if (from->nins > to->nouts)
+			usefrom = 0;
 	}
-    } else {
-	if (to->nins == 0) {
-	    /*
-	     * Was the state's only inarc.
-	     */
-
-	    moveouts(nfa, to, from);
-	    freestate(nfa, to);
+		
+	freearc(nfa, a);
+	if (usefrom) {
+		if (from->nouts == 0) {
+			/* was the state's only outarc */
+			moveins(nfa, from, to);
+			freestate(nfa, from);
+		} else
+			copyins(nfa, from, to);
 	} else {
-	    copyouts(nfa, to, from);
+		if (to->nins == 0) {
+			/* was the state's only inarc */
+			moveouts(nfa, to, from);
+			freestate(nfa, to);
+		} else
+			copyouts(nfa, to, from);
 	}
-    }
 
-    return 1;
+	return 1;
 }
-
+
 /*
  - cleanup - clean up NFA after optimizations
- ^ static void cleanup(struct nfa *);
+ ^ static VOID cleanup(struct nfa *);
  */
-static void
-cleanup(
-    struct nfa *nfa)
+static VOID
+cleanup(nfa)
+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, 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, (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);
 	}
-    }
-    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 *,
+ ^ static VOID markreachable(struct nfa *, struct state *, struct state *,
  ^ 	struct state *);
  */
-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 */
+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 */
 {
-    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 *,
+ ^ static VOID markcanreach(struct nfa *, struct state *, struct state *,
  ^ 	struct state *);
  */
-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 */
+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 */
 {
-    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(
-    struct nfa *nfa)
+analyze(nfa)
+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(struct nfa *, struct cnfa *);
  */
-static void
-compact(
-    struct nfa *nfa,
-    struct cnfa *cnfa)
+static VOID
+compact(nfa, cnfa)
+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 */
-    }
-
-    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);
+	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 */
 	}
-	if (cnfa->arcs != NULL) {
-	    FREE(cnfa->arcs);
+
+	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;
 	}
-	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;
+	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++;
-		break;
-	    case LACON:
-		assert(s->no != cnfa->pre);
-		ca->co = (color) (cnfa->ncolors + a->co);
-		ca->to = a->to->no;
+		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;
 		ca++;
-		cnfa->flags |= HASLACONS;
-		break;
-	    default:
-		assert(NOTREACHED);
-		break;
-	    }
 	}
-	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;
+	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(struct carc *, struct carc *);
  */
-static void
-carcsort(
-    struct carc *first,
-    struct carc *last)
+static VOID
+carcsort(first, last)
+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(struct cnfa *);
  */
-static void
-freecnfa(
-    struct cnfa *cnfa)
+static VOID
+freecnfa(cnfa)
+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(struct nfa *, FILE *);
  */
-static void
-dumpnfa(
-    struct nfa *nfa,
-    FILE *f)
+static VOID
+dumpnfa(nfa, f)
+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
@@ -1634,187 +1476,167 @@ dumpnfa(
 
 /*
  - dumpstate - dump an NFA state in human-readable form
- ^ static void dumpstate(struct state *, FILE *);
+ ^ static VOID dumpstate(struct state *, FILE *);
  */
-static void
-dumpstate(
-    struct state *s,
-    FILE *f)
+static VOID
+dumpstate(s, f)
+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(struct state *, FILE *);
  */
-static void
-dumparcs(
-    struct state *s,
-    FILE *f)
+static VOID
+dumparcs(s, f)
+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(
-    struct arc *a,
-    struct state *s,
-    FILE *f,
-    int pos)			/* initial print position */
+dumprarcs(a, s, f, pos)
+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(struct arc *, struct state *, FILE *);
  */
-static void
-dumparc(
-    struct arc *a,
-    struct state *s,
-    FILE *f)
+static VOID
+dumparc(a, s, f)
+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;
-    }
-    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 */
-	    }
+	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 (aa < &ab->a[ABSIZE]) {	/* propagate break */
-	    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 (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 */
+	if (ab == NULL)
+		fprintf(f, "?!?");	/* not in allocated space */
+	fprintf(f, "->");
+	if (a->to == NULL) {
+		fprintf(f, "NULL");
+		return;
 	}
-    }
-    if (aa == NULL) {
-	fprintf(f, "?!?");	/* missing from in-chain */
-    }
+	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 */
 }
 
 /*
  ^ #endif
  */
 #endif				/* ifdef REG_DEBUG */
-
+
 /*
  - dumpcnfa - dump a compacted NFA in human-readable form
- ^ static void dumpcnfa(struct cnfa *, FILE *);
+ ^ static VOID dumpcnfa(struct cnfa *, FILE *);
  */
-static void
-dumpcnfa(
-    struct cnfa *cnfa,
-    FILE *f)
+static VOID
+dumpcnfa(cnfa, f)
+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
@@ -1822,48 +1644,38 @@ dumpcnfa(
 
 /*
  - dumpcstate - dump a compacted-NFA state in human-readable form
- ^ static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+ ^ static VOID dumpcstate(int, struct carc *, struct cnfa *, FILE *);
  */
-static void
-dumpcstate(
-    int st,
-    struct carc *ca,
-    struct cnfa *cnfa,
-    FILE *f)
+static VOID
+dumpcstate(st, ca, cnfa, f)
+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 (pos == 5) {
+			fprintf(f, "\n");
+			pos = 1;
+		} else
+			pos++;
 	}
-    }
-    if (i == 1 || pos != 1) {
-	fprintf(f, "\n");
-    }
-    fflush(f);
+	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 65555aa..a1fe5bc 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,189 +38,198 @@
 /* =====^!^===== begin forwards =====^!^===== */
 /* automatically gathered by fwd; do not hand-edit */
 /* === regcomp.c === */
-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);
+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));
 /* === regc_lex.c === */
-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 int lexdigits(struct vars *, int, int, int);
-static int brenext(struct vars *, pchr);
-static void skip(struct vars *);
-static chr newline(NOPARMS);
+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));
 #ifdef REG_DEBUG
-static const chr *ch(NOPARMS);
+static CONST chr *ch _ANSI_ARGS_((NOPARMS));
 #endif
-static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
+static chr chrnamed _ANSI_ARGS_((struct vars *, CONST chr *, CONST chr *, pchr));
 /* === regc_color.c === */
-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 *);
+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 *));
 #ifdef REG_DEBUG
-static void dumpcolors(struct colormap *, FILE *);
-static void fillcheck(struct colormap *, union tree *, int, FILE *);
-static void dumpchr(pchr, FILE *);
+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 *));
 #endif
 /* === regc_nfa.c === */
-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 *, int);
-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 *);
+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 *));
 #define	INCOMPATIBLE	1	/* destroys arc */
 #define	SATISFIED	2	/* constraint satisfied */
 #define	COMPATIBLE	3	/* compatible but not satisfied yet */
-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 *);
+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 *));
 #ifdef REG_DEBUG
-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 *);
+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 *));
 #endif
-static void dumpcnfa(struct cnfa *, FILE *);
+static VOID dumpcnfa _ANSI_ARGS_((struct cnfa *, FILE *));
 #ifdef REG_DEBUG
-static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
+static VOID dumpcstate _ANSI_ARGS_((int, struct carc *, struct cnfa *, FILE *));
 #endif
 /* === regc_cvec.c === */
-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 *);
+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 *));
 /* === regc_locale.c === */
-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);
+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));
 /* 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 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 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 */
 };
 
 /* 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 */
@@ -250,459 +259,387 @@ 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(
-    regex_t *re,
-    const chr *string,
-    size_t len,
-    int flags)
+compile(re, string, len, flags)
+regex_t *re;
+CONST chr *string;
+size_t len;
+int flags;
 {
-    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++) {
+	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========= LA%d ==========\n", i);
+		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);
 	}
-	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 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);
 }
-
+
 /*
  - moresubs - enlarge subRE vector
- ^ static void moresubs(struct vars *, int);
+ ^ static VOID moresubs(struct vars *, int);
  */
-static void
-moresubs(
-    struct vars *v,
-    int wanted)			/* want enough room for this one */
+static VOID
+moresubs(v, wanted)
+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(p, v->subs, v->nsubs * sizeof(struct subre *));
+	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;
 	}
-    } 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);
+	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(
-    struct vars *v,
-    int err)
+freev(v, err)
+struct vars *v;
+int 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;
+	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;
 }
-
+
 /*
  - 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(
-    struct vars *v,
-    struct nfa *nfa)
+static VOID
+makesearch(v, nfa)
+struct vars *v;
+struct nfa *nfa;
 {
-    struct arc *a, *b;
-    struct state *pre = nfa->pre;
-    struct state *s, *s2, *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;
+	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.
-	 */
+	if (a != NULL) {
+		/* add implicit .* in front */
+		rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
 
-	rainbow(nfa, v->cm, PLAIN, COLORLESS, pre, pre);
+		/* 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);
+	}
 
 	/*
-	 * And ^* and \A* too -- not always necessary, but harmless.
+	 * 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.
 	 */
 
-	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;
+	/* 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;
+			}
+		}
 	}
-    }
 
-    /*
-     * 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);
-	    }
+	/* 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 */
 	}
-	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(
-    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(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 */
 {
-    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();
-	EMPTYARC(init, left);
-	EMPTYARC(right, final);
-	NOERRN();
-	branch->left = parsebranch(v, stopper, type, left, right, 0);
+	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);
 	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;
-	    }
+	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);
 	}
-    } while (EAT('|'));
-    assert(SEE(stopper) || SEE(EOS));
-
-    if (!SEE(stopper)) {
-	assert(stopper == ')' && SEE(EOS));
-	ERR(REG_EPAREN);
-    }
 
-    /*
-     * Optimize out simple cases.
-     */
+	/* 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 (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;
+	return branches;
 }
-
+
 /*
  - parsebranch - parse one branch of an RE
  * This mostly manages concatenation, working closely with parseqatom().
@@ -712,1446 +649,1458 @@ parse(
  ^ 	struct state *, int);
  */
 static struct subre *
-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? */
+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? */
 {
-    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;
+	struct state *lp;	/* left end of current construct */
+	int seencontent;	/* is there anything in this branch yet? */
+	struct subre *t;
 
-	/* NB, recursion in parseqatom() may swallow rest of branch */
-	parseqatom(v, stopper, type, lp, right, 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);
+	}
 
-    if (!seencontent) {		/* empty branch */
-	if (!partial) {
-	    NOTE(REG_UUNSPEC);
+	if (!seencontent) {		/* empty branch */
+		if (!partial)
+			NOTE(REG_UUNSPEC);
+		assert(lp == left);
+		EMPTYARC(left, right);
 	}
-	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(
-    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(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 */
 {
-    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;
-    case '$':
-	ARCV('$', 1);
-	if (v->cflags&REG_NLANCH) {
-	    ARCV(AHEAD, v->nlcolor);
+	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;
 	}
-	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;
-
-	/*
-	 * 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;
+	/* ...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;
 	}
 
-	/*
-	 * Legal in EREs due to specification botch.
-	 */
+	/* 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;
+	}
 
-	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);
+	/* 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;
 	}
-	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.
+	 * hard part:  something messy
+	 * That is, capturing parens, back reference, short/long clash, or
+	 * an atom with substructure containing one of those.
 	 */
 
-    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 '(' */
+	/* now we'll need a subre for the contents even if they're boring */
+	if (atom == NULL) {
+		atom = subre(v, '=', 0, lp, rp);
+		NOERR();
 	}
-	NEXT();
 
 	/*
-	 * Need new endpoints because tree will contain pointers.
+	 * 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);
+	s = newstate(v->nfa);		/* first, new endpoints for the atom */
 	s2 = newstate(v->nfa);
 	NOERR();
-	EMPTYARC(lp, s);
-	EMPTYARC(s2, rp);
+	moveouts(v->nfa, lp, s);
+	moveins(v->nfa, rp, s2);
 	NOERR();
-	atom = parse(v, ')', PLAIN, s, s2);
-	assert(SEE(')') || ISERR());
-	NEXT();
+	atom->begin = s;
+	atom->end = s2;
+	s = newstate(v->nfa);		/* and spots for prefix and bypass */
+	s2 = newstate(v->nfa);
 	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);
+	EMPTYARC(lp, s);
+	EMPTYARC(lp, s2);
 	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;
-    }
-
-    /*
-     * ...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;
+	/* 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();
 	}
-	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;
+	/* 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;
 	}
-	delsub(v->nfa, lp, rp);
-	EMPTYARC(lp, rp);
-	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);
+	/* 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;
 	}
-	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);
+	/* 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(
-    struct vars *v,
-    int dir,			/* AHEAD or BEHIND */
-    struct state *lp,
-    struct state *rp)
+static VOID
+nonword(v, dir, lp, rp)
+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(
-    struct vars *v,
-    int dir,			/* AHEAD or BEHIND */
-    struct state *lp,
-    struct state *rp)
+static VOID
+word(v, dir, lp, rp)
+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(
-    struct vars *v)
+scannum(v)
+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(
-    struct vars *v,
-    struct state *lp,
-    struct state *rp,
-    int m,
-    int n)
+static VOID
+repeat(v, lp, rp, m, n)
+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, *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;
+	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;
+	}
 }
-
+
 /*
  - 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(
-    struct vars *v,
-    struct state *lp,
-    struct state *rp)
+static VOID
+bracket(v, lp, rp)
+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(
-    struct vars *v,
-    struct state *lp,
-    struct state *rp)
+static VOID
+cbracket(v, lp, rp)
+struct vars *v;
+struct state *lp;
+struct state *rp;
 {
-    struct state *left = newstate(v->nfa);
-    struct state *right = newstate(v->nfa);
+	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;
 
-    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, and all there is to do since the MCCE code
-     * was removed.
-     */
+	/* 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;
+	}
 
-    colorcomplement(v->nfa, v->cm, PLAIN, left, lp, rp);
-    NOERR();
-    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();
+	}
+
+	delsub(v->nfa, left, right);
+	assert(left->nouts == 0);
+	freestate(v->nfa, left);
+	assert(right->nins == 0);
+	freestate(v->nfa, right);
 }
-
+
 /*
  - 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(
-    struct vars *v,
-    struct state *lp,
-    struct state *rp)
+static VOID
+brackpart(v, lp, rp)
+struct vars *v;
+struct state *lp;
+struct state *rp;
 {
-    celt startc, endc;
-    struct cvec *cv;
-    const chr *startp, *endp;
-    chr c;
-
-    /*
-     * 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 = v->nextvalue;
-	NEXT();
-
-	/*
-	 * Shortcut for ordinary chr (not range).
-	 */
-
-	if (!SEE(RANGE)) {
-	    onechr(v, c, 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();
+	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 */
 	switch (v->nexttype) {
+	case RANGE:			/* a-b-c or other botch */
+		ERR(REG_ERANGE);
+		return;
+		break;
 	case PLAIN:
-	case RANGE:
-	    c = v->nextvalue;
-	    NEXT();
-	    endc = element(v, &c, &c+1);
-	    NOERR();
-	    break;
+		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 COLLEL:
-	    startp = v->now;
-	    endp = scanplain(v);
-	    INSIST(startp < endp, REG_ECOLLATE);
-	    NOERR();
-	    endc = element(v, startp, endp);
-	    NOERR();
-	    break;
+		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_ERANGE);
-	    return;
-	    break;
+		ERR(REG_ASSERT);
+		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.
-     */
+	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;
 
-    if (startc != endc) {
-	NOTE(REG_UUNPORT);
-    }
-    cv = range(v, startc, endc, (v->cflags&REG_ICASE));
-    NOERR();
-    dovec(v, cv, lp, rp);
+	/*
+	 * 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);
 }
-
+
 /*
  - 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 const 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 chr *scanplain(struct vars *);
  */
-static const chr *		/* just after end of sequence */
-scanplain(
-    struct vars *v)
+static CONST chr *			/* just after end of sequence */
+scanplain(v)
+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;
-	NEXT();
-    }
+	while (SEE(PLAIN)) {
+		endp = v->now;
+		NEXT();
+	}
 
-    assert(SEE(END) || ISERR());
-    NEXT();
+	assert(SEE(END) || ISERR());
+	NEXT();
 
-    return endp;
+	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(
-    struct vars *v,
-    pchr c,
-    struct state *lp,
-    struct state *rp)
+static VOID
+onechr(v, c, lp, rp)
+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;
-    }
-
-    /*
-     * Rats, need general case anyway...
-     */
+	if (!(v->cflags&REG_ICASE)) {
+		newarc(v->nfa, PLAIN, subcolor(v->cm, c), lp, rp);
+		return;
+	}
 
-    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
- ^ static void dovec(struct vars *, struct cvec *, struct state *,
+ * This one has to handle the messy cases, like MCCEs and MCCE leaders.
+ ^ static VOID dovec(struct vars *, struct cvec *, struct state *,
  ^ 	struct state *);
  */
-static void
-dovec(
-    struct vars *v,
-    struct cvec *cv,
-    struct state *lp,
-    struct state *rp)
+static VOID
+dovec(v, cv, lp, rp)
+struct vars *v;
+struct cvec *cv;
+struct state *lp;
+struct state *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);
+	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);
 	}
-    }
 
+	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();
+	}
 }
-
+
 /*
- - 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 *);
+ - nextleader - find next MCCE leader within range
+ ^ static celt nextleader(struct vars *, pchr, pchr);
  */
-static void
-wordchrs(
-    struct vars *v)
+static celt			/* NOCELT means none */
+nextleader(v, from, to)
+struct vars *v;
+pchr from;
+pchr to;
 {
-    struct state *left, *right;
-
-    if (v->wordchrs != NULL) {
-	NEXT();		/* for consistency */
-	return;
-    }
+	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;
+}
 
-    left = newstate(v->nfa);
-    right = newstate(v->nfa);
-    NOERR();
+/*
+ - 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 *);
+ */
+static VOID
+wordchrs(v)
+struct vars *v;
+{
+	struct state *left;
+	struct state *right;
 
-    /*
-     * Fine point: implemented with [::], and lexer will set REG_ULOCALE.
-     */
+	if (v->wordchrs != NULL) {
+		NEXT();		/* for consistency */
+		return;
+	}
 
-    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(
-    struct vars *v,
-    int op,
-    int flags,
-    struct state *begin,
-    struct state *end)
+subre(v, op, flags, begin, end)
+struct vars *v;
+int op;
+int flags;
+struct state *begin;
+struct state *end;
 {
-    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;
+	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;
 	}
-	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;
+
+	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(
-    struct vars *v,		/* might be NULL */
-    struct subre *sr)
+static VOID
+freesubre(v, sr)
+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(
-    struct vars *v,		/* might be NULL */
-    struct subre *sr)
+static VOID
+freesrnode(v, sr)
+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(
-    struct vars *v,
-    struct subre *t)
+static VOID
+optst(v, t)
+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 spends effort traversing the tree and doing nothing. We can do
+     * just spent 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(
-    struct subre *t,
-    int start)			/* starting point for subtree numbers */
+numst(t, start)
+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(
-    struct subre *t)
+static VOID
+markst(t)
+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(
-    struct vars *v)
+static VOID
+cleanst(v)
+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(
-    struct vars *v,
-    struct subre *t,
-    FILE *f)			/* for debug output */
+nfatree(v, t, f)
+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(
-    struct vars *v,
-    struct subre *t,
-    FILE *f)			/* for debug output */
+nfanode(v, t, f)
+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(
-    struct vars *v,
-    struct state *begin,
-    struct state *end,
-    int pos)
+newlacon(v, begin, end, pos)
+struct vars *v;
+struct state *begin;
+struct state *end;
+int pos;
 {
-    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;
+	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;
 }
-
+
 /*
  - freelacons - free lookahead-constraint subRE vector
- ^ static void freelacons(struct subre *, int);
+ ^ static VOID freelacons(struct subre *, int);
  */
-static void
-freelacons(
-    struct subre *subs,
-    int n)
+static VOID
+freelacons(subs, n)
+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(
-    regex_t *re)
+static VOID
+rfree(re)
+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(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((struct vars *)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(
-    regex_t *re,
-    FILE *f)
+static VOID
+dump(re, f)
+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(
-    struct subre *t,
-    FILE *f,
-    int nfapresent)		/* is the original NFA still around? */
+static VOID
+dumpst(t, f, nfapresent)
+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(
-    struct subre *t,
-    FILE *f,
-    int nfapresent)		/* is the original NFA still around? */
+static VOID
+stdump(t, f, nfapresent)
+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);
+	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);
 	}
-	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);
-    }
-    fprintf(f, "\n");
-    if (t->left != NULL) {
-	stdump(t->left, f, nfapresent);
-    }
-    if (t->right != NULL) {
-	stdump(t->right, f, nfapresent);
-    }
+	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 const char *stid(struct subre *, char *, size_t);
+ ^ static char *stid(struct subre *, char *, size_t);
  */
-static const char *			/* points to buf or constant string */
-stid(
-    struct subre *t,
-    char *buf,
-    size_t bufsize)
+static char *			/* points to buf or constant string */
+stid(t, buf, bufsize)
+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"
@@ -2159,11 +2108,3 @@ stid(
 #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 1c970ea..5b6815c 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,28 +26,23 @@
  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-/*
- * Headers if any.
- */
+/* headers if any */
+#include "tclInt.h"
 
-#include "regex.h"
+/* overrides for regguts.h definitions, if any */
+#define	FUNCPTR(name, args)	(*name) _ANSI_ARGS_(args)
+#define	MALLOC(n)		ckalloc(n)
+#define	FREE(p)			ckfree(VS(p))
+#define	REALLOC(p,n)		ckrealloc(VS(p),n)
 
-/*
- * Overrides for regguts.h definitions, if any.
- */
 
-#define	FUNCPTR(name, args)	(*name)args
-#define	MALLOC(n)		VS(attemptckalloc(n))
-#define	FREE(p)			ckfree(VS(p))
-#define	REALLOC(p,n)		VS(attemptckrealloc(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
@@ -72,92 +67,54 @@
 #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.
- */
 
-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 */
+
+/* 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 */
 #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
 
-/*
- * 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
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
+/* and pick up the standard header */
+#include "regex.h"
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
index 920ea6c..bc391fd 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,776 +29,649 @@
  * 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(
-    struct vars *const v,	/* used only for debug and exec flags */
-    struct dfa *const d,
-    chr *const start,		/* where the match should start */
-    chr *const stop,		/* match must end at or before here */
-    int *const hitstopp)	/* record whether hit v->stop, if non-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 */
 {
-    chr *cp;
-    chr *realstop = (stop == v->stop) ? stop : stop + 1;
-    color co;
-    struct sset *css, *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));
 	}
-    } 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 */
+	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;
+		}
+	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;
-	}
-    }
-
-    /*
-     * 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 */
+	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;
+	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(
-    struct vars *const v,
-    struct dfa *const d,
-    chr *const start,		/* where the match should start */
-    chr *const min,		/* match must end at or after here */
-    chr *const max,		/* match must end at or before here */
-    chr **const coldp,		/* store coldstart pointer here, if nonNULL */
-    int *const hitstopp)	/* record whether hit v->stop, if non-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 */
 {
-    chr *cp;
-    chr *realmin = (min == v->stop) ? min : min + 1;
-    chr *realmax = (max == v->stop) ? max : max + 1;
-    color co;
-    struct sset *css, *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));
 	}
-    } 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 */
+	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 */
+		}
+	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 */
-	    }
-	}
-    }
 
-    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 *);
+ - lastcold - determine last point at which no progress had been made
+ ^ static chr *lastcold(struct vars *, struct dfa *);
  */
 static chr *			/* endpoint, or NULL */
-lastCold(
-    struct vars *const v,
-    struct dfa *const d)
+lastcold(v, d)
+struct vars *v;
+struct dfa *d;
 {
-    struct sset *ss;
-    chr *nopr = d->lastnopr;
-    int i;
-
-    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 *,
+ - newdfa - set up a fresh DFA
+ ^ static struct dfa *newdfa(struct vars *, struct cnfa *,
  ^ 	struct colormap *, struct smalldfa *);
  */
 static struct dfa *
-newDFA(
-    struct vars *const v,
-    struct cnfa *const cnfa,
-    struct colormap *const cm,
-    struct smalldfa *sml)	/* preallocated space, may be NULL */
+newdfa(v, cnfa, cm, small)
+struct vars *v;
+struct cnfa *cnfa;
+struct colormap *cm;
+struct smalldfa *small;		/* preallocated space, may be 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 = &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;
+	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;
+		}
 	}
-    }
-
-    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->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 *);
+ - freedfa - free a DFA
+ ^ static VOID freedfa(struct dfa *);
  */
-static void
-freeDFA(
-    struct dfa *const d)
+static VOID
+freedfa(d)
+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->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->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(
-    unsigned *const uv,
-    const int n)
+hash(uv, n)
+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(
-    struct vars *const v,	/* used only for debug flags */
-    struct dfa *const d,
-    chr *const start)
+initialize(v, d, start)
+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 = getVacantSS(v, d, start, start);
-	for (i = 0; i < d->wordsper; i++) {
-	    ss->states[i] = 0;
+	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 */
 	}
-	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;
+
+	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(
-    struct vars *const v,	/* used only for debug flags */
-    struct dfa *const d,
-    struct sset *const css,
-    const pcolor co,
-    chr *const cp,		/* next chr */
-    chr *const start)		/* where the attempt got started */
+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 */
 {
-    struct cnfa *cnfa = d->cnfa;
-    unsigned h;
-    struct carc *ca;
-    struct sset *p;
-    int i, isPost, noProgress, gotState, doLAConstraints, sawLAConstraints;
-
-    /*
-     * 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));
-		}
-	    }
+	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];
 	}
-    }
-    doLAConstraints = (gotState ? (cnfa->flags&HASLACONS) : 0);
-    sawLAConstraints = 0;
-    while (doLAConstraints) {		/* transitive closure */
-	doLAConstraints = 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 */
-		    }
-		    sawLAConstraints = 1;
-		    if (ISBSET(d->work, ca->to)) {
-			continue;	/* NOTE CONTINUE */
-		    }
-		    if (!checkLAConstraint(v, cnfa, cp, ca->co)) {
-			continue;	/* NOTE CONTINUE */
-		    }
-		    BSET(d->work, ca->to);
-		    doLAConstraints = 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 */
-	 }
-    }
-    if (i == 0) {		/* nope, need a new cache entry */
-	p = getVacantSS(v, d, cp, start);
-	assert(p != css);
-	for (i = 0; i < d->wordsper; i++) {
-	    p->states[i] = d->work[i];
+	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));
+				}
 	}
-	p->hash = h;
-	p->flags = (isPost ? POSTSTATE : 0);
-	if (noProgress) {
-	    p->flags |= NOPROGRESS;
+	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;
+		/* lastseen to be dealt with by caller */
 	}
 
-	/*
-	 * lastseen to be dealt with by caller
-	 */
-    }
-
-    if (!sawLAConstraints) {	/* 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;
+	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;
 }
-
+
 /*
- - checkLAConstraint - lookahead-constraint checker for miss()
- ^ static int checkLAConstraint(struct vars *, struct cnfa *, chr *, pcolor);
+ - lacon - lookahead-constraint checker for miss()
+ ^ static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
  */
 static int			/* predicate:  constraint satisfied? */
-checkLAConstraint(
-    struct vars *const v,
-    struct cnfa *const pcnfa,	/* parent cnfa */
-    chr *const cp,
-    const pcolor co)		/* "color" of the lookahead constraint */
+lacon(v, pcnfa, cp, co)
+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, 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);
 }
-
+
 /*
- - getVacantSS - get a vacant state set
+ - getvacant - get a vacant state set
  * This routine clears out the inarcs and outarcs, but does not otherwise
  * clear the innards of the state set -- that's up to the caller.
- ^ static struct sset *getVacantSS(struct vars *, struct dfa *, chr *, chr *);
+ ^ static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
  */
 static struct sset *
-getVacantSS(
-    struct vars *const v,	/* used only for debug flags */
-    struct dfa *const d,
-    chr *const cp,
-    chr *const start)
+getvacant(v, d, cp, start)
+struct vars *v;			/* used only for debug flags */
+struct dfa *d;
+chr *cp;
+chr *start;
 {
-    int i;
-    struct sset *ss, *p;
-    struct arcp ap, lastap = {NULL, 0}; /* silence gcc 4 warning */
-    color co;
-
-    ss = pickNextSS(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 */
-	}
-	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];
+	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->outs[i] = NULL;
-	ss->inchain[i].ss = NULL;
-    }
-
-    /*
-     * If ss was a success state, may need to remember location.
-     */
+	ss->ins.ss = NULL;
 
-    if ((ss->flags&POSTSTATE) && ss->lastseen != d->lastpost &&
-	    (d->lastpost == NULL || d->lastpost < ss->lastseen)) {
-	d->lastpost = ss->lastseen;
-    }
+	/* 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;
+	}
 
-    /*
-     * Likewise for a no-progress state.
-     */
+	/* 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->flags&NOPROGRESS) && ss->lastseen != d->lastnopr &&
-	    (d->lastnopr == NULL || d->lastnopr < ss->lastseen)) {
-	d->lastnopr = ss->lastseen;
-    }
+	/* 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;
+	return ss;
 }
-
+
 /*
- - pickNextSS - pick the next stateset to be used
- ^ static struct sset *pickNextSS(struct vars *, struct dfa *, chr *, chr *);
+ - pickss - pick the next stateset to be used
+ ^ static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
  */
 static struct sset *
-pickNextSS(
-    struct vars *const v,	/* used only for debug flags */
-    struct dfa *const d,
-    chr *const cp,
-    chr *const start)
+pickss(v, d, cp, start)
+struct vars *v;			/* used only for debug flags */
+struct dfa *d;
+chr *cp;
+chr *start;
 {
-    int i;
-    struct sset *ss, *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;
+	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;
 	}
-    }
 
-    /*
-     * Nobody's old enough?!? -- something's really wrong.
-     */
+	/* 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;
+		}
 
-    FDEBUG(("can't find victim to replace!\n"));
-    assert(NOTREACHED);
-    ERR(REG_ASSERT);
-    return d->ssets;
+	/* nobody's old enough?!? -- something's really wrong */
+	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 a1a0163..6376e80 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,99 +31,79 @@
 
 #include "regguts.h"
 
-/*
- * Unknown-error explanation.
- */
-
-static const char unk[] = "*** unknown regex error code 0x%x ***";
-
-/*
- * Struct to map among codes, code names, and explanations.
- */
+/* unknown-error explanation */
+static CONST char unk[] = "*** unknown regex error code 0x%x ***";
 
+/* struct to map among codes, code names, and explanations */
 static struct rerr {
-    int code;
-    const char *name;
-    const char *explain;
+	int code;
+	char *name;
+	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(
-    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(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 */
 {
-    struct rerr *r;
-    const char *msg;
-    char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
-    size_t len;
-    int icode;
+	struct rerr *r;
+	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) {
+	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;
 		break;
-	    }
-	}
-	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) {
+	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;
+		}
 		break;
-	    }
-	}
-	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) {
+	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;
-	    }
-	}
-	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 d6d46ce..a35925a 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -1,26 +1,23 @@
 #ifndef _REGEX_H_
 #define	_REGEX_H_	/* never again */
-
-#include "tclInt.h"
-
 /*
  * 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
@@ -33,35 +30,38 @@
  * 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,15 +69,18 @@
 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
@@ -107,8 +110,8 @@ extern "C" {
 /* 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
+#define	__REG_VOID_T	VOID
+#define	__REG_CONST	CONST
 /* names and declarations */
 #define	__REG_WIDE_COMPILE	TclReComp
 #define	__REG_WIDE_EXEC		TclReExec
@@ -118,14 +121,15 @@ 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;
@@ -144,8 +148,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
@@ -159,41 +163,43 @@ 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
@@ -225,6 +231,8 @@ typedef struct {
 #define	REG_FAKE	010000	/* none of your business :-) */
 #define	REG_PROGRESS	020000	/* none of your business :-) */
 
+
+
 /*
  * execution
  ^ #ifndef __REG_NOCHAR
@@ -246,19 +254,23 @@ 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);
  */
@@ -285,6 +297,8 @@ 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
  */
@@ -292,28 +306,30 @@ typedef struct {
 /* automatically gathered by fwd; do not hand-edit */
 /* === regproto.h === */
 #ifndef __REG_NOCHAR
-int re_comp(regex_t *, __REG_CONST char *, size_t, int);
+int re_comp _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, int));
 #endif
 #ifndef __REG_NOFRONT
-int regcomp(regex_t *, __REG_CONST char *, int);
+int regcomp _ANSI_ARGS_((regex_t *, __REG_CONST char *, int));
 #endif
 #ifdef __REG_WIDE_T
-MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
+int __REG_WIDE_COMPILE _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int));
 #endif
 #ifndef __REG_NOCHAR
-int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+int re_exec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
 #endif
 #ifndef __REG_NOFRONT
-int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
+int regexec _ANSI_ARGS_((regex_t *, __REG_CONST char *, size_t, regmatch_t [], int));
 #endif
 #ifdef __REG_WIDE_T
-MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
+int __REG_WIDE_EXEC _ANSI_ARGS_((regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int));
 #endif
-MODULE_SCOPE re_void regfree(regex_t *);
-MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
+re_void regfree _ANSI_ARGS_((regex_t *));
+extern size_t regerror _ANSI_ARGS_((int, __REG_CONST regex_t *, char *, size_t));
 /* automatically gathered by fwd; do not hand-edit */
 /* =====^!^===== end forwards =====^!^===== */
 
+
+
 /*
  * more C++ voodoo
  */
@@ -321,12 +337,6 @@ MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
 }
 #endif
 
-#endif
 
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
+
+#endif
diff --git a/generic/regexec.c b/generic/regexec.c
index 9b6a693..be459d3 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,1198 +26,1015 @@
  * 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(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
-static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const);
-static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const);
-static int complicatedFindLoop(struct vars *const, struct cnfa *const, struct colormap *const, struct dfa *const, struct dfa *const, chr **const);
-static void zapSubexpressions(regmatch_t *const, const size_t);
-static void zapSubtree(struct vars *const, struct subre *const);
-static void subset(struct vars *const, struct subre *const, chr *const, chr *const);
-static int dissect(struct vars *const, struct subre *, chr *const, chr *const);
-static int concatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int alternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
-static inline int complicatedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedCapturingDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedConcatenationDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedReversedDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedBackrefDissect(struct vars *const, struct subre *const, chr *const, chr *const);
-static int complicatedAlternationDissect(struct vars *const, struct subre *, chr *const, chr *const);
+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 *));
 /* === rege_dfa.c === */
-static chr *longest(struct vars *const, struct dfa *const, chr *const, chr *const, int *const);
-static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *const, chr *const, chr **const, int *const);
-static chr *lastCold(struct vars *const, struct dfa *const);
-static struct dfa *newDFA(struct vars *const, struct cnfa *const, struct colormap *const, struct smalldfa *);
-static void freeDFA(struct dfa *const);
-static unsigned hash(unsigned *const, const int);
-static struct sset *initialize(struct vars *const, struct dfa *const, chr *const);
-static struct sset *miss(struct vars *const, struct dfa *const, struct sset *const, const pcolor, chr *const, chr *const);
-static int checkLAConstraint(struct vars *const, struct cnfa *const, chr *const, const pcolor);
-static struct sset *getVacantSS(struct vars *const, struct dfa *const, chr *const, chr *const);
-static struct sset *pickNextSS(struct vars *const, struct dfa *const, chr *const, chr *const);
+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 *));
 /* 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 *,
+ ^ int exec(regex_t *, CONST chr *, size_t, rm_detail_t *,
  ^					size_t, regmatch_t [], int);
  */
 int
-exec(
-    regex_t *re,
-    const chr *string,
-    size_t len,
-    rm_detail_t *details,
-    size_t nmatch,
-    regmatch_t pmatch[],
-    int flags)
+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;
 {
-    AllocVars(v);
-    int st, backref;
-    size_t n;
-#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));
-	}
-	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));
+	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));
 	}
-	if (v->mem == NULL) {
-	    if (v->pmatch != pmatch && v->pmatch != mat) {
+
+	/* clean up */
+	if (v->pmatch != pmatch && v->pmatch != mat)
 		FREE(v->pmatch);
-	    }
-	    FreeVars(v);
-	    return REG_ESPACE;
-	}
-    } else {
-	v->mem = NULL;
-    }
-
-    /*
-     * Do it.
-     */
-
-    assert(v->g->tree != NULL);
-    if (backref) {
-	st = complicatedFind(v, &v->g->tree->cnfa, &v->g->cmap);
-    } else {
-	st = simpleFind(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) {
-	zapSubexpressions(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;
+	if (v->mem != NULL && v->mem != mem)
+		FREE(v->mem);
+	return st;
 }
-
+
 /*
- - simpleFind - find a match for the main NFA (no-complications case)
- ^ static int simpleFind(struct vars *, struct cnfa *, struct colormap *);
+ - find - find a match for the main NFA (no-complications case)
+ ^ static int find(struct vars *, struct cnfa *, struct colormap *);
  */
 static int
-simpleFind(
-    struct vars *const v,
-    struct cnfa *const cnfa,
-    struct colormap *const cm)
+find(v, cnfa, cm)
+struct vars *v;
+struct cnfa *cnfa;
+struct colormap *cm;
 {
-    struct dfa *s, *d;
-    chr *begin, *end = NULL;
-    chr *cold;
-    chr *open, *close;		/* Open and close of range of possible
-				 * starts */
-    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);
-	}
+	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 (hitend && cold == NULL) {
-	    cold = begin;
+	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 (end != NULL) {
-	    break;		/* NOTE BREAK OUT */
+	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 */
 	}
-    }
-    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);
+	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 */
 	}
-	v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
-    }
-    if (v->nmatch == 1) {	/* no need for submatches */
-	return REG_OKAY;
-    }
-
-    /*
-     * Submatches.
-     */
-
-    zapSubexpressions(v->pmatch, v->nmatch);
-    return dissect(v, v->g->tree, begin, end);
+	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);
 }
-
+
 /*
- - complicatedFind - find a match for the main NFA (with complications)
- ^ static int complicatedFind(struct vars *, struct cnfa *, struct colormap *);
+ - cfind - find a match for the main NFA (with complications)
+ ^ static int cfind(struct vars *, struct cnfa *, struct colormap *);
  */
 static int
-complicatedFind(
-    struct vars *const v,
-    struct cnfa *const cnfa,
-    struct colormap *const cm)
+cfind(v, cnfa, cm)
+struct vars *v;
+struct cnfa *cnfa;
+struct colormap *cm;
 {
-    struct dfa *s, *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 = complicatedFindLoop(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);
+	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;
 	}
-	v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
-    }
-    return ret;
+
+	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);
+		v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
+	}
+	return ret;
 }
-
+
 /*
- - complicatedFindLoop - the heart of complicatedFind
- ^ static int complicatedFindLoop(struct vars *, struct cnfa *, struct colormap *,
+ - cfindloop - the heart of cfind
+ ^ static int cfindloop(struct vars *, struct cnfa *, struct colormap *,
  ^	struct dfa *, struct dfa *, chr **);
  */
 static int
-complicatedFindLoop(
-    struct vars *const v,
-    struct cnfa *const cnfa,
-    struct colormap *const cm,
-    struct dfa *const d,
-    struct dfa *const s,
-    chr **const coldp)		/* where to put coldstart pointer */
+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 */
 {
-    chr *begin, *end;
-    chr *cold;
-    chr *open, *close;		/* Open and close of range of possible
-				 * starts */
-    chr *estart, *estop;
-    int er, hitend;
-    int shorter = v->g->tree->flags&SHORTER;
-
-    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;
+	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;
-	MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
-	for (begin = open; begin <= close; begin++) {
-	    MDEBUG(("\ncomplicatedFind 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 */
-		}
-
-		MDEBUG(("tentative end %ld\n", LOFF(end)));
-		zapSubexpressions(v->pmatch, v->nmatch);
-		zapSubtree(v, v->g->tree);
-		er = complicatedDissect(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;
+	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;
+			}
 		}
+	} while (close < v->stop);
 
-		/*
-		 * Go around and try again
-		 */
-
-		if (shorter) {
-		    estart = end + 1;
-		} else {
-		    estop = end - 1;
-		}
-	    }
-	}
-    } while (close < v->stop);
-
-    *coldp = cold;
-    return REG_NOMATCH;
+	*coldp = cold;
+	return REG_NOMATCH;
 }
-
+
 /*
- - zapSubexpressions - initialize the subexpression matches to "no match"
- ^ static void zapSubexpressions(regmatch_t *, size_t);
+ - zapsubs - initialize the subexpression matches to "no match"
+ ^ static VOID zapsubs(regmatch_t *, size_t);
  */
-static void
-zapSubexpressions(
-    regmatch_t *const p,
-    const size_t n)
+static VOID
+zapsubs(p, n)
+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;
+	}
 }
-
+
 /*
- - zapSubtree - initialize the retry memory of a subtree to zeros
- ^ static void zapSubtree(struct vars *, struct subre *);
+ - zapmem - initialize the retry memory of a subtree to zeros
+ ^ static VOID zapmem(struct vars *, struct subre *);
  */
-static void
-zapSubtree(
-    struct vars *const v,
-    struct subre *const t)
+static VOID
+zapmem(v, t)
+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;
-	v->pmatch[t->subno].rm_eo = -1;
-    }
-
-    if (t->left != NULL) {
-	zapSubtree(v, t->left);
-    }
-    if (t->right != NULL) {
-	zapSubtree(v, t->right);
-    }
+	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);
 }
-
+
 /*
  - subset - set any subexpression relevant to a successful subre
- ^ static void subset(struct vars *, struct subre *, chr *, chr *);
+ ^ static VOID subset(struct vars *, struct subre *, chr *, chr *);
  */
-static void
-subset(
-    struct vars *const v,
-    struct subre *const sub,
-    chr *const begin,
-    chr *const end)
+static VOID
+subset(v, sub, begin, end)
+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(
-    struct vars *const v,
-    struct subre *t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+dissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin;			/* beginning of relevant substring */
+chr *end;			/* end of same */
 {
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
-  restart:
-#endif
-    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 alternationDissect(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 concatenationDissect(v, t, begin, end);
-    case '(':			/* capturing */
-	assert(t->left != NULL && t->right == NULL);
-	assert(t->subno > 0);
-	subset(v, t, begin, end);
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
-	t = t->left;
-	goto restart;
-#else
-	return dissect(v, t->left, begin, end);
-#endif
-    default:
-	return REG_ASSERT;
-    }
-}
-
-/*
- - concatenationDissect - determine concatenation subexpression matches
- - (uncomplicated)
- ^ static int concatenationDissect(struct vars *, struct subre *, chr *, chr *);
- */
-static int			/* regexec return code */
-concatenationDissect(
-    struct vars *const v,
-    struct subre *const t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
-{
-    struct dfa *d, *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;
-	}
-	if (shorter) {
-	    mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
-	} else {
-	    mid = longest(v, d, begin, mid-1, NULL);
-	}
-	if (mid == NULL) {
-	    /*
-	     * Failed to find a new one!
-	     */
-
-	    MDEBUG(("failed midpoint!\n"));
-	    freeDFA(d);
-	    freeDFA(d2);
-	    return REG_ASSERT;
+	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;
 	}
-	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);
 }
-
+
 /*
- - alternationDissect - determine alternative subexpression matches (uncomplicated)
- ^ static int alternationDissect(struct vars *, struct subre *, chr *, chr *);
+ - condissect - determine concatenation subexpression matches (uncomplicated)
+ ^ static int condissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-alternationDissect(
-    struct vars *const v,
-    struct subre *t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+condissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin;			/* beginning of relevant substring */
+chr *end;			/* end of same */
 {
-    int i;
-
-    assert(t != NULL);
-    assert(t->op == '|');
-
-    for (i = 0; t != NULL; t = t->right, i++) {
 	struct dfa *d;
+	struct dfa *d2;
+	chr *mid;
+	int i;
+	int shorter = (t->left->flags&SHORTER) ? 1 : 0;
+	chr *stop = (shorter) ? end : begin;
 
-	MDEBUG(("trying %dth\n", i));
+	assert(t->op == '.');
 	assert(t->left != NULL && t->left->cnfa.nstates > 0);
-	d = newDFA(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
+	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()) {
-	    return v->err;
+		assert(d2 == NULL);
+		freedfa(d);
+		return v->err;
 	}
-	if (longest(v, d, begin, end, NULL) == end) {
-	    MDEBUG(("success\n"));
-	    freeDFA(d);
-	    return dissect(v, t->left, begin, end);
+
+	/* 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;
+	}
+	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)));
 	}
-	freeDFA(d);
-    }
-    return REG_ASSERT;		/* none of them matched?!? */
+
+	/* 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);
 }
-
+
 /*
- - complicatedDissect - 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".
- ^ static int complicatedDissect(struct vars *, struct subre *, chr *, chr *);
+ - altdissect - determine alternative subexpression matches (uncomplicated)
+ ^ static int altdissect(struct vars *, struct subre *, chr *, chr *);
  */
-static inline int		/* regexec return code */
-complicatedDissect(
-    struct vars *const v,
-    struct subre *const t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+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 */
 {
-    assert(t != NULL);
-    MDEBUG(("complicatedDissect %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 complicatedAlternationDissect(v, t, begin, end);
-    case 'b':			/* back ref -- shouldn't be calling us! */
-	assert(t->left == NULL && t->right == NULL);
-	return complicatedBackrefDissect(v, t, begin, end);
-    case '.':			/* concatenation */
-	assert(t->left != NULL && t->right != NULL);
-	return complicatedConcatenationDissect(v, t, begin, end);
-    case '(':			/* capturing */
-	assert(t->left != NULL && t->right == NULL);
-	assert(t->subno > 0);
-	return complicatedCapturingDissect(v, t, begin, end);
-    default:
-	return REG_ASSERT;
-    }
+	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);
+	}
+	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".
+ ^ static int cdissect(struct vars *, struct subre *, chr *, chr *);
+ */
 static int			/* regexec return code */
-complicatedCapturingDissect(
-    struct vars *const v,
-    struct subre *const t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+cdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin;			/* beginning of relevant substring */
+chr *end;			/* end of same */
 {
-    int er = complicatedDissect(v, t->left, begin, end);
-
-    if (er == REG_OKAY) {
-	subset(v, t, begin, end);
-    }
-    return er;
+	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;
+	}
 }
-
+
 /*
- - complicatedConcatenationDissect - 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".
- ^ static int complicatedConcatenationDissect(struct vars *, struct subre *, chr *, chr *);
+ - 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".
+ ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-complicatedConcatenationDissect(
-    struct vars *const v,
-    struct subre *const t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+ccondissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin;			/* beginning of relevant substring */
+chr *end;			/* end of same */
 {
-    struct dfa *d, *d2;
-    chr *mid;
-
-    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 complicatedReversedDissect(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));
-
-    /*
-     * Pick a tentative midpoint.
-     */
-
-    if (v->mem[t->retry] == 0) {
-	mid = longest(v, d, begin, end, NULL);
-	if (mid == NULL) {
-	    freeDFA(d);
-	    freeDFA(d2);
-	    return REG_NOMATCH;
+	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);
+
+	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(("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) {
-	    int er = complicatedDissect(v, t->left, begin, mid);
-
-	    if (er == REG_OKAY) {
-		er = complicatedDissect(v, t->right, mid, end);
-		if (er == REG_OKAY) {
-		    /*
-		     * Satisfaction.
-		     */
-
-		    MDEBUG(("successful\n"));
-		    freeDFA(d);
-		    freeDFA(d2);
-		    return REG_OKAY;
+	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;
 		}
-	    }
-	    if ((er != REG_OKAY) && (er != REG_NOMATCH)) {
-		freeDFA(d);
-		freeDFA(d2);
-		return er;
-	    }
+		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)));
 	}
 
-	/*
-	 * That midpoint didn't work, find a new one.
-	 */
-
-	if (mid == begin) {
-	    /*
-	     * All possibilities exhausted.
-	     */
+	/* 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;
+			}
+		}
 
-	    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;
+		/* 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);
 	}
-	MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
-	v->mem[t->retry] = (mid - begin) + 1;
-	zapSubtree(v, t->left);
-	zapSubtree(v, t->right);
-    }
 }
-
+
 /*
- - complicatedReversedDissect - 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".
- ^ static int complicatedReversedDissect(struct vars *, struct subre *, chr *, chr *);
+ - 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".
+ ^ static int crevdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-complicatedReversedDissect(
-    struct vars *const v,
-    struct subre *const t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+crevdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin;			/* beginning of relevant substring */
+chr *end;			/* end of same */
 {
-    struct dfa *d, *d2;
-    chr *mid;
-
-    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));
-
-    /*
-     * Pick a tentative midpoint.
-     */
-
-    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;
+	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(("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) {
-	    int er = complicatedDissect(v, t->left, begin, mid);
-
-	    if (er == REG_OKAY) {
-		er = complicatedDissect(v, t->right, mid, end);
-		if (er == REG_OKAY) {
-		    /*
-		     * Satisfaction.
-		     */
-
-		    MDEBUG(("successful\n"));
-		    freeDFA(d);
-		    freeDFA(d2);
-		    return REG_OKAY;
+	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;
 		}
-	    }
-	    if (er != REG_OKAY && er != REG_NOMATCH) {
-		freeDFA(d);
-		freeDFA(d2);
-		return er;
-	    }
+		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)));
 	}
 
-	/*
-	 * That midpoint didn't work, find a new one.
-	 */
-
-	if (mid == end) {
-	    /*
-	     * All possibilities exhausted.
-	     */
+	/* 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;
+			}
+		}
 
-	    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;
+		/* 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);
 	}
-	MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
-	v->mem[t->retry] = (mid - begin) + 1;
-	zapSubtree(v, t->left);
-	zapSubtree(v, t->right);
-    }
 }
-
+
 /*
- - complicatedBackrefDissect - determine backref subexpression matches
- ^ static int complicatedBackrefDissect(struct vars *, struct subre *, chr *, chr *);
+ - cbrdissect - determine backref subexpression matches
+ ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-complicatedBackrefDissect(
-    struct vars *const v,
-    struct subre *const t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+cbrdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin;			/* beginning of relevant substring */
+chr *end;			/* end of same */
 {
-    int i, n = t->subno, min = t->min, max = t->max;
-    chr *paren, *p, *stop;
-    size_t len;
-
-    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;
+	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;
 	}
-	return REG_NOMATCH;
-    }
-
-    /*
-     * 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;
+	/* 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++;
-    }
-    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 */
+	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 */
 }
-
+
 /*
- - complicatedAlternationDissect - determine alternative subexpression matches (w.
- - complications)
- ^ static int complicatedAlternationDissect(struct vars *, struct subre *, chr *, chr *);
+ - caltdissect - determine alternative subexpression matches (w. complications)
+ ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
  */
 static int			/* regexec return code */
-complicatedAlternationDissect(
-    struct vars *const v,
-    struct subre *t,
-    chr *const begin,		/* beginning of relevant substring */
-    chr *const end)		/* end of same */
+caltdissect(v, t, begin, end)
+struct vars *v;
+struct subre *t;
+chr *begin;			/* beginning of relevant substring */
+chr *end;			/* end of same */
 {
-    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 */
-
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
-    if (0) {
-    doRight:
-	t = t->right;
-    }
-#endif
-    if (t == NULL) {
-	return REG_NOMATCH;
-    }
-    assert(t->op == '|');
-    if (v->mem[t->retry] == TRIED) {
-	goto doRight;
-    }
+	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);
 
-    MDEBUG(("cAlt n%d\n", t->retry));
-    assert(t->left != NULL);
+	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 (v->mem[t->retry] == UNTRIED) {
-	struct dfa *d = newDFA(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
+	er = cdissect(v, t->left, begin, end);
+	if (er != REG_NOMATCH)
+		return er;
 
-	if (ISERR()) {
-	    return v->err;
-	}
-	if (longest(v, d, begin, end, NULL) != end) {
-	    freeDFA(d);
-	    v->mem[t->retry] = TRIED;
-	    goto doRight;
-	}
-	freeDFA(d);
-	MDEBUG(("cAlt matched\n"));
-	v->mem[t->retry] = TRYING;
-    }
-
-    er = complicatedDissect(v, t->left, begin, end);
-    if (er != REG_NOMATCH) {
-	return er;
-    }
-
-    v->mem[t->retry] = TRIED;
-#ifndef COMPILER_DOES_TAILCALL_OPTIMIZATION
-    goto doRight;
-#else
-  doRight:
-    return complicatedAlternationDissect(v, t->right, begin, end);
-#endif
+	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 b0aaa70..17a7389 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,11 +27,13 @@
  * 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"
@@ -41,20 +43,11 @@
  *
  * Ignoring invocation with NULL is a convenience.
  */
-void
-regfree(
-    regex_t *re)
+VOID
+regfree(re)
+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 088a640..82f48e2 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,63 +29,55 @@
  * 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(
-    regex_t *re,
-    const char *str,
-    int flags)
+regcomp(re, str, flags)
+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(
-    regex_t *re,
-    const char *str,
-    size_t nmatch,
-    regmatch_t pmatch[],
-    int flags)
+regexec(re, str, nmatch, pmatch, flags)
+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 e57b8f8..c77a8fc 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,42 +28,60 @@
  * 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.
  */
 
+/* standard header files (NULL is a reasonable indicator for them) */
+#ifndef NULL
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <limits.h>
+#include <string.h>
+#endif
+
 /* assertions */
 #ifndef assert
-#ifndef REG_DEBUG
-#ifndef NDEBUG
-#define	NDEBUG		/* no assertions */
-#endif
-#endif /* !REG_DEBUG */
+#	ifndef REG_DEBUG
+#	ifndef NDEBUG
+#	define	NDEBUG		/* no assertions */
+#	endif
+#	endif
 #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)	((void*)(x))	/* cast something to generic ptr */
+#define	VS(x)	((PVOID)(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 */
 #endif
 
 /* function-pointer declarator */
@@ -87,10 +105,15 @@
 #endif
 
 /* want size of a char in bits, and max value in bounded quantifiers */
+#ifndef CHAR_BIT
+#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
  */
@@ -103,6 +126,8 @@
 
 #define	REMAGIC	0xfed7		/* magic number for main struct */
 
+
+
 /*
  * debugging facilities
  */
@@ -116,6 +141,8 @@
 #define	MDEBUG(arglist)	{}
 #endif
 
+
+
 /*
  * bitmap manipulation
  */
@@ -123,13 +150,14 @@
 #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
@@ -138,66 +166,69 @@
 #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 descriptor structure for the color machinery */
+/* internal per-color 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 */
@@ -216,196 +247,182 @@ 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 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 */
 };
 
+/* caution:  this value cannot be changed easily */
+#define	MAXMCCE	2		/* length of longest MCCE */
+
+
+
 /*
- * definitions for non-deterministic finite autmaton (NFA) internal
- * representation
+ * definitions for 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 *colorchainRev;	/* 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 *colorchain_rev;	/* 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 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 */
+	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 */
 };
 
+
+
 /*
  * 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 8355d99..a061c76 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -7,8 +7,6 @@
 #
 # 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.
 
@@ -21,7 +19,6 @@ library tcl
 
 interface tcl
 hooks {tclPlat tclInt tclIntPlat}
-scspec EXTERN
 
 # Declare each of the functions in the public Tcl interface.  Note that
 # the an index should never be reused for a different function in order
@@ -29,12 +26,12 @@ scspec EXTERN
 
 declare 0 {
     int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
-	    const char *version, const void *clientData)
+	    const char *version, ClientData clientData)
 }
 declare 1 {
     CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
 	    const char *name, const char *version, int exact,
-	    void *clientDataPtr)
+	    ClientData *clientDataPtr)
 }
 declare 2 {
     void Tcl_Panic(const char *format, ...)
@@ -52,7 +49,7 @@ declare 6 {
     char *Tcl_DbCkalloc(unsigned int size, const char *file, int line)
 }
 declare 7 {
-    void Tcl_DbCkfree(char *ptr, const char *file, int line)
+    int Tcl_DbCkfree(char *ptr, const char *file, int line)
 }
 declare 8 {
     char *Tcl_DbCkrealloc(char *ptr, unsigned int size,
@@ -71,13 +68,13 @@ declare 10 unix {
     void Tcl_DeleteFileHandler(int fd)
 }
 declare 11 {
-    void Tcl_SetTimer(const Tcl_Time *timePtr)
+    void Tcl_SetTimer(Tcl_Time *timePtr)
 }
 declare 12 {
     void Tcl_Sleep(int ms)
 }
 declare 13 {
-    int Tcl_WaitForEvent(const Tcl_Time *timePtr)
+    int Tcl_WaitForEvent(Tcl_Time *timePtr)
 }
 declare 14 {
     int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr)
@@ -93,7 +90,7 @@ declare 17 {
 }
 declare 18 {
     int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr,
-	    const Tcl_ObjType *typePtr)
+	    Tcl_ObjType *typePtr)
 }
 declare 19 {
     void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line)
@@ -154,7 +151,7 @@ declare 35 {
 }
 declare 36 {
     int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-	    CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
+	    CONST84 char **tablePtr, const char *msg, int flags, int *indexPtr)
 }
 declare 37 {
     int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
@@ -166,7 +163,7 @@ declare 39 {
     int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
 }
 declare 40 {
-    CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName)
+    Tcl_ObjType *Tcl_GetObjType(const char *typeName)
 }
 declare 41 {
     char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
@@ -326,7 +323,7 @@ declare 87 {
 	    Tcl_Obj *const objv[])
 }
 declare 88 {
-    Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
+    Tcl_Channel Tcl_CreateChannel(Tcl_ChannelType *typePtr,
 	    const char *chanName, ClientData instanceData, int mask)
 }
 declare 89 {
@@ -411,7 +408,7 @@ declare 109 {
 declare 110 {
     void Tcl_DeleteInterp(Tcl_Interp *interp)
 }
-declare 111 {
+declare 111 {unix win} {
     void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr)
 }
 declare 112 {
@@ -566,7 +563,7 @@ declare 157 {
 	    const char *optionName, Tcl_DString *dsPtr)
 }
 declare 158 {
-    CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
+    Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
 }
 declare 159 {
     int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
@@ -702,7 +699,7 @@ declare 196 {
     Tcl_Obj *Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 	    Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
 }
-declare 197 {
+declare 197 {unix win} {
     Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
 	    CONST84 char **argv, int flags)
 }
@@ -738,7 +735,7 @@ declare 205 {
 declare 206 {
     int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
 }
-declare 207 {
+declare 207 {unix win} {
     void Tcl_ReapDetachedProcs(void)
 }
 declare 208 {
@@ -751,7 +748,7 @@ declare 210 {
     void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
 }
 declare 211 {
-    void Tcl_RegisterObjType(const Tcl_ObjType *typePtr)
+    void Tcl_RegisterObjType(Tcl_ObjType *typePtr)
 }
 declare 212 {
     Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern)
@@ -812,7 +809,7 @@ declare 228 {
     void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
 }
 declare 229 {
-    void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
+    void Tcl_SetMaxBlockTime(Tcl_Time *timePtr)
 }
 declare 230 {
     void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
@@ -965,7 +962,7 @@ declare 271 {
 declare 272 {
     CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
 	    const char *name, const char *version, int exact,
-	    void *clientDataPtr)
+	    ClientData *clientDataPtr)
 }
 declare 273 {
     int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
@@ -1011,7 +1008,7 @@ declare 280 {
 
 declare 281 {
     Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
-	    const Tcl_ChannelType *typePtr, ClientData instanceData,
+	    Tcl_ChannelType *typePtr, ClientData instanceData,
 	    int mask, Tcl_Channel prevChan)
 }
 declare 282 {
@@ -1036,7 +1033,7 @@ declare 286 {
     void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
 }
 declare 287 {
-    Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr)
+    Tcl_Encoding Tcl_CreateEncoding(Tcl_EncodingType *typePtr)
 }
 declare 288 {
     void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
@@ -1118,7 +1115,7 @@ declare 310 {
 }
 declare 311 {
     void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
-	    const Tcl_Time *timePtr)
+	    Tcl_Time *timePtr)
 }
 declare 312 {
     int Tcl_NumUtfChars(const char *src, int length)
@@ -1390,7 +1387,7 @@ declare 392 {
     void Tcl_MutexFinalize(Tcl_Mutex *mutex)
 }
 declare 393 {
-    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
+    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc,
 	    ClientData clientData, int stackSize, int flags)
 }
 
@@ -1408,59 +1405,59 @@ declare 397 {
     int Tcl_ChannelBuffered(Tcl_Channel chan)
 }
 declare 398 {
-    CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
+    CONST84_RETURN char *Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
 }
 declare 399 {
     Tcl_ChannelTypeVersion Tcl_ChannelVersion(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 400 {
     Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 401 {
     Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 402 {
     Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 403 {
     Tcl_DriverInputProc *Tcl_ChannelInputProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 404 {
     Tcl_DriverOutputProc *Tcl_ChannelOutputProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 405 {
     Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 406 {
     Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 407 {
     Tcl_DriverGetOptionProc *Tcl_ChannelGetOptionProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 408 {
     Tcl_DriverWatchProc *Tcl_ChannelWatchProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 409 {
     Tcl_DriverGetHandleProc *Tcl_ChannelGetHandleProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 410 {
     Tcl_DriverFlushProc *Tcl_ChannelFlushProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 declare 411 {
     Tcl_DriverHandlerProc *Tcl_ChannelHandlerProc(
-	    const Tcl_ChannelType *chanTypePtr)
+	    Tcl_ChannelType *chanTypePtr)
 }
 
 # Introduced in 8.4a2
@@ -1494,15 +1491,16 @@ declare 420 {
 	    const Tcl_UniChar *uniPattern, int nocase)
 }
 declare 421 {
-    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
+    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const char *key)
 }
+
 declare 422 {
     Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
-	    const void *key, int *newPtr)
+	    const char *key, int *newPtr)
 }
 declare 423 {
     void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
-	    const Tcl_HashKeyType *typePtr)
+	    Tcl_HashKeyType *typePtr)
 }
 declare 424 {
     void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
@@ -1617,7 +1615,7 @@ declare 452 {
 	    int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
 }
 declare 453 {
-    const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
+    const char **Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
 	    Tcl_Obj **objPtrRef)
 }
 declare 454 {
@@ -1657,7 +1655,7 @@ declare 464 {
 }
 declare 465 {
     ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
-	    const Tcl_Filesystem *fsPtr)
+	    Tcl_Filesystem *fsPtr)
 }
 declare 466 {
     Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
@@ -1666,11 +1664,11 @@ declare 467 {
     int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
 }
 declare 468 {
-    Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem,
+    Tcl_Obj *Tcl_FSNewNativePath(Tcl_Filesystem *fromFilesystem,
 	    ClientData clientData)
 }
 declare 469 {
-    const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
+    const char *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
 }
 declare 470 {
     Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr)
@@ -1682,20 +1680,20 @@ declare 472 {
     Tcl_Obj *Tcl_FSListVolumes(void)
 }
 declare 473 {
-    int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr)
+    int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr)
 }
 declare 474 {
-    int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
+    int Tcl_FSUnregister(Tcl_Filesystem *fsPtr)
 }
 declare 475 {
-    ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr)
+    ClientData Tcl_FSData(Tcl_Filesystem *fsPtr)
 }
 declare 476 {
     const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
 	    Tcl_Obj *pathPtr)
 }
 declare 477 {
-    CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
+    Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
 }
 declare 478 {
     Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
@@ -1706,7 +1704,7 @@ declare 479 {
     int Tcl_OutputBuffered(Tcl_Channel chan)
 }
 declare 480 {
-    void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr)
+    void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)
 }
 
 # TIP#56 (evaluate a parsed script) msofer
@@ -1763,615 +1761,123 @@ declare 492 {
 # TIP#91 (back-compat enhancements for channels) dkf
 declare 493 {
     Tcl_DriverWideSeekProc *Tcl_ChannelWideSeekProc(
-	    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,
-	    const 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)
+	    Tcl_ChannelType *chanTypePtr)
 }
 
-# TIP#137 (encoding-aware source command) dgp for Anton Kovalenko
-declare 518 {
-    int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName,
-	    const char *encodingName)
-}
-
-# 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)
-}
+# 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#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
 declare 554 {
     Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
-	    const Tcl_ChannelType *chanTypePtr)
-}
-
-# 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)
+	    Tcl_ChannelType *chanTypePtr)
 }
 
-# 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)
-}
+# 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#268 (extended version numbers and requirements) akupries
 declare 573 {
     int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name,
-	    int objc, Tcl_Obj *const objv[], void *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, ...)
+	    int objc, Tcl_Obj *const objv[], ClientData *clientDataPtr)
 }
-declare 579 {
-    void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...)
-}
-
-# ----- BASELINE -- FOR -- 8.5.0 ----- #
 
-# TIP #285 (script cancellation support) jmistachkin
-declare 580 {
-    int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr,
-	    ClientData clientData, int flags)
-}
-declare 581 {
-    int Tcl_Canceled(Tcl_Interp *interp, int flags)
-}
+##############################################################################
 
-# TIP#304 (chan pipe) aferrieux
-declare 582 {
-    int Tcl_CreatePipe(Tcl_Interp  *interp, Tcl_Channel *rchan,
-	    Tcl_Channel *wchan, int flags)
-}
+# Define the platform specific public Tcl interface.  These functions are
+# only available on the designated platform.
 
-# TIP #322 (NRE public interface) msofer
-declare 583 {
-    Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp,
-	    const char *cmdName, Tcl_ObjCmdProc *proc,
-	    Tcl_ObjCmdProc *nreProc, ClientData clientData,
-	    Tcl_CmdDeleteProc *deleteProc)
-}
-declare 584 {
-    int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
-}
-declare 585 {
-    int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
-	    int flags)
-}
-declare 586 {
-    int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc,
-	    Tcl_Obj *const objv[], int flags)
-}
-declare 587 {
-    void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr,
-	    ClientData data0, ClientData data1, ClientData data2,
-	    ClientData data3)
-}
-# For use by NR extenders, to have a simple way to also provide a (required!)
-# classic objProc
-declare 588 {
-    int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc,
-	    ClientData clientData, int objc, Tcl_Obj *const objv[])
-}
-
-# TIP#316 (Tcl_StatBuf reader functions) dkf
-declare 589 {
-    unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 590 {
-    unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 591 {
-    unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 592 {
-    int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 593 {
-    int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 594 {
-    int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 595 {
-    int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 596 {
-    Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 597 {
-    Tcl_WideInt Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 598 {
-    Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 599 {
-    Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 600 {
-    Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr)
-}
-declare 601 {
-    unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr)
-}
+interface tclPlat
 
-# TIP#314 (ensembles with parameters) dkf for Lars Hellstr"om
-declare 602 {
-    int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
-	    Tcl_Obj *paramList)
-}
-declare 603 {
-    int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
-	    Tcl_Obj **paramListPtr)
-}
+################################
+# Windows specific functions
 
-# TIP#265 (option parser) dkf for Sam Bromley
-declare 604 {
-    int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
-	    int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
-}
+# Added in Tcl 8.1
 
-# TIP#336 (manipulate the error line) dgp
-declare 605 {
-    int Tcl_GetErrorLine(Tcl_Interp *interp)
+declare 0 win {
+    TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
 }
-declare 606 {
-    void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum)
+declare 1 win {
+    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
 }
 
-# TIP#307 (move results between interpreters) dkf
-declare 607 {
-    void Tcl_TransferResult(Tcl_Interp *sourceInterp, int result,
-	    Tcl_Interp *targetInterp)
-}
+##################
+# Mac declarations
 
-# TIP#335 (detect if interpreter in use) jmistachkin
-declare 608 {
-    int Tcl_InterpActive(Tcl_Interp *interp)
+# This is needed by the shells to handle Macintosh events.
+ 
+declare 0 mac {
+    void Tcl_MacSetEventProc(Tcl_MacConvertEventPtr procPtr)
 }
 
-# TIP#337 (log exception for background processing) dgp
-declare 609 {
-    void Tcl_BackgroundException(Tcl_Interp *interp, int code)
-}
+# These routines are useful for handling using scripts from resources 
+# in the application shell
 
-# TIP#234 (zlib interface) dkf/Pascal Scheffers
-declare 610 {
-    int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
-	    int level, Tcl_Obj *gzipHeaderDictObj)
-}
-declare 611 {
-    int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
-	    int buffersize, Tcl_Obj *gzipHeaderDictObj)
-}
-declare 612 {
-    unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf,
-	    int len)
-}
-declare 613 {
-    unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf,
-	    int len)
-}
-declare 614 {
-    int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format,
-	    int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle)
-}
-declare 615 {
-    Tcl_Obj *Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle)
-}
-declare 616 {
-    int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle)
+declare 1 mac {
+    char *Tcl_MacConvertTextResource(Handle resource)
 }
-declare 617 {
-    int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle)
+declare 2 mac {
+    int Tcl_MacEvalResource(Tcl_Interp *interp, const char *resourceName,
+	    int resourceNumber, const char *fileName)
 }
-declare 618 {
-    int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush)
-}
-declare 619 {
-    int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count)
-}
-declare 620 {
-    int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle)
-}
-declare 621 {
-    int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle)
+declare 3 mac {
+    Handle Tcl_MacFindResource(Tcl_Interp *interp, long resourceType,
+	    const char *resourceName, int resourceNumber,
+	    const char *resFileRef, int *releaseIt)
 }
 
-# TIP 338 (control over startup script) dgp
-declare 622 {
-    void Tcl_SetStartupScript(Tcl_Obj *path, const char *encoding)
-}
-declare 623 {
-    Tcl_Obj *Tcl_GetStartupScript(const char **encodingPtr)
-}
+# These routines support the new OSType object type (i.e. the packed 4
+# character type and creator codes).
 
-# TIP#332 (half-close made public) aferrieux
-declare 624 {
-    int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags)
+declare 4 mac {
+    int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+	    OSType *osTypePtr)
 }
-
-# TIP #353 (NR-enabled expressions) dgp
-declare 625 {
-    int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr)
+declare 5 mac {
+    void Tcl_SetOSTypeObj(Tcl_Obj *objPtr, OSType osType)
 }
-
-# TIP #356 (NR-enabled substitution) dgp
-declare 626 {
-    int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
+declare 6 mac {
+    Tcl_Obj *Tcl_NewOSTypeObj(OSType osType)
 }
 
-# TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk
-declare 627 {
-    int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-		     const char *const symv[], int flags, void *procPtrs,
-		     Tcl_LoadHandle *handlePtr)
-}
-declare 628 {
-    void *Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle,
-			 const char *symbol)
+# These are not in MSL 2.1.2, so we need to export them from the
+# Tcl shared library.  They are found in the compat directory.
+ 
+declare 7 mac {
+    int strncasecmp(const char *s1, const char *s2, size_t n)
 }
-declare 629 {
-    int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
-}
-
-# ----- BASELINE -- FOR -- 8.6.0 ----- #
-
-##############################################################################
-
-# Define the platform specific public Tcl interface. These functions are only
-# available on the designated platform.
-
-interface tclPlat
-
-################################
-# Unix specific functions
-#   (none)
-
-################################
-# Windows specific functions
-
-# Added in Tcl 8.1
-
-declare 0 win {
-    TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
-}
-declare 1 win {
-    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
+declare 8 mac {
+    int strcasecmp(const char *s1, const char *s2)
 }
 
 ################################
 # Mac OS X specific functions
 
-declare 0 {unix macosx} {
+declare 0 unix {
     int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
 	    const char *bundleName, int hasResourceFile,
 	    int maxPathLen, char *libraryPath)
 }
-declare 1 {unix macosx} {
+declare 1 unix {
     int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
 	    const char *bundleName, const char *bundleVersion,
 	    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_PkgInitStubsCheck(Tcl_Interp *interp, const char *version,
-	int exact)
-}
-export {
-    void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
-}
-
 # Local Variables:
 # mode: tcl
 # End:
diff --git a/generic/tcl.h b/generic/tcl.h
index 729e521..3c6ef5e 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,39 +34,37 @@ 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	(1 LOC patch)
+ * library/init.tcl	(only if Major.minor changes, not patchlevel) 1 LOC
  * unix/configure.in	(2 LOC Major, 2 LOC minor, 1 LOC patch)
  * win/configure.in	(as above)
  * win/tcl.m4		(not patchlevel)
- * win/makefile.bc	(not patchlevel) 2 LOC
- * README		(sections 0 and 2, with and without separator)
+ * win/makefile.vc	(not patchlevel) 2 LOC
+ * README		(sections 0 and 2)
+ * mac/README		(2 LOC, not patchlevel)
  * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC
  * macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC
- * 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.binary	(sections 0-4)
  * win/README		(not patchlevel) (sections 0 and 2)
- * unix/tcl.spec	(1 LOC patch)
+ * unix/tcl.spec	(2 LOC Major/Minor, 1 LOC patch)
+ * tests/basic.test	(1 LOC M/M, not patchlevel)
  * 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   6
-#define TCL_RELEASE_LEVEL   TCL_BETA_RELEASE
-#define TCL_RELEASE_SERIAL  2
+#define TCL_MINOR_VERSION   4
+#define TCL_RELEASE_LEVEL   TCL_FINAL_RELEASE
+#define TCL_RELEASE_SERIAL  19
+
+#define TCL_VERSION	    "8.4"
+#define TCL_PATCH_LEVEL	    "8.4.19"
 
-#define TCL_VERSION	    "8.6"
-#define TCL_PATCH_LEVEL	    "8.6b2"
-
 /*
- *----------------------------------------------------------------------------
- * 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__
@@ -92,10 +90,26 @@ extern "C" {
 #endif /* __WIN32__ */
 
 /*
+ * The following definitions set up the proper options for Macintosh
+ * compilers.  We use this method because there is no autoconf equivalent.
+ */
+
+#ifdef MAC_TCL
+#include <ConditionalMacros.h>
+#   ifndef USE_TCLALLOC
+#	define USE_TCLALLOC 1
+#   endif
+#   ifndef NO_STRERROR
+#	define NO_STRERROR 1
+#   endif
+#   define INLINE 
+#endif
+
+
+/*
  * 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
@@ -105,20 +119,21 @@ 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 or mac resource files so that they can obtain version
+ * information.  RC_INVOKED is defined by default by the windows RC tool
+ * and manually set for macintosh.
  *
- * Resource compilers don't like all the C stuff, like typedefs and function
- * declarations, that occur below, so block them out.
+ * Resource compilers don't like all the C stuff, like typedefs and
+ * procedure 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
@@ -128,85 +143,62 @@ extern "C" {
 #endif
 
 /*
- * 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.
+ * Macros that eliminate the overhead of the thread synchronization
+ * functions when compiling without thread support.
  */
 
-#include <stdio.h>
+#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 */
 
-/*
- *----------------------------------------------------------------------------
- * 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.
- */
 
-#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
-#if defined(__GNUC__) && (__GNUC__ > 2)
-#   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
-#else
-#   define TCL_FORMAT_PRINTF(a,b)
+#ifndef BUFSIZ
+#   include <stdio.h>
 #endif
 
+
 /*
- * Allow a part of Tcl's API to be explicitly marked as deprecated.
- *
- * Used to make TIP 330/336 generate moans even if people use the
- * compatibility macros. Change your code, guys! We won't support you forever.
+ * 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.
  */
-
-#if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1)))
-#   if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5))
-#	define TCL_DEPRECATED_API(msg)	__attribute__ ((__deprecated__ (msg)))
-#   else
-#	define TCL_DEPRECATED_API(msg)	__attribute__ ((__deprecated__))
-#   endif
+#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
-#   define TCL_DEPRECATED_API(msg)	/* nothing portable */
+#   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))
 #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.
- *
- * 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.
+ * 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.
  */
 
 #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
@@ -215,25 +207,23 @@ 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
@@ -246,34 +236,26 @@ extern "C" {
 #endif
 
 /*
- * The following _ANSI_ARGS_ macro is to support old extensions
- * written for older versions of Tcl where it permitted support
- * for compilers written in the pre-prototype era of C.
- *
- * New code should use prototypes.
- */
-
-#ifndef TCL_NO_DEPRECATED
-#   undef _ANSI_ARGS_
-#   define _ANSI_ARGS_(x)	x
-#endif
-
-/*
- * Definitions that allow this header file to be used either with or without
- * ANSI C features.
+ * Definitions that allow this header file to be used either with or
+ * without ANSI C features like function prototypes.
  */
 
+#undef _ANSI_ARGS_
+#undef CONST
 #ifndef INLINE
 #   define INLINE
 #endif
 
-#ifdef NO_CONST
-#   ifndef const
-#      define const
-#   endif
-#endif
-#ifndef CONST
+#ifndef NO_CONST
 #   define CONST const
+#else
+#   define CONST
+#endif
+
+#ifndef NO_PROTOTYPES
+#   define _ANSI_ARGS_(x)	x
+#else
+#   define _ANSI_ARGS_(x)	()
 #endif
 
 #ifdef USE_NON_CONST
@@ -285,19 +267,15 @@ extern "C" {
 #else
 #   ifdef USE_COMPAT_CONST
 #      define CONST84
-#      define CONST84_RETURN const
+#      define CONST84_RETURN CONST
 #   else
-#      define CONST84 const
-#      define CONST84_RETURN const
+#      define CONST84 CONST
+#      define CONST84_RETURN CONST
 #   endif
 #endif
 
-#ifndef CONST86
-#      define CONST86 CONST84
-#endif
-
 /*
- * Make sure EXTERN isn't defined elsewhere.
+ * Make sure EXTERN isn't defined elsewhere
  */
 
 #ifdef EXTERN
@@ -311,10 +289,12 @@ 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)
@@ -327,14 +307,15 @@ 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
 
 /*
@@ -359,23 +340,22 @@ 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.
@@ -384,9 +364,12 @@ 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 function
- * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
+ * 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.)
  */
 
 #if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
@@ -394,16 +377,19 @@ 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
@@ -432,14 +418,16 @@ 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)))
@@ -480,67 +468,59 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
     typedef struct stat Tcl_StatBuf;
 #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 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.
+ * 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.
  *
- * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
+ * Note: Tcl_ObjCmdProc procedures 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().
  */
 
 typedef struct Tcl_Interp {
-    /* TIP #330: Strongly discourage extensions from using the string
-     * result. */
-#ifdef USE_INTERP_RESULT
-    char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
-				/* If the last command returned a string
+    char *result;		/* If the last command returned a string
 				 * result, this points to it. */
-    void (*freeProc) (char *blockPtr)
-	    TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
-				/* 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. */
-#else
-    char *unused3 TCL_DEPRECATED_API("bad field access");
-    void (*unused4) (char *) TCL_DEPRECATED_API("bad field access");
-#endif
-#ifdef USE_INTERP_ERRORLINE
-    int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
-				/* When TCL_ERROR is returned, this gives the
-				 * line number within the command where the
-				 * error occurred (1 if first line). */
-#else
-    int unused5 TCL_DEPRECATED_API("bad field access");
-#endif
+    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). */
 } 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;
@@ -549,28 +529,32 @@ 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_ZLibStream_ *Tcl_ZlibStream;
+typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
+typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle;
 
 /*
- *----------------------------------------------------------------------------
- * 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.
+ * 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.
  */
-
-#if defined __WIN32__
-typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
+#ifdef MAC_TCL
+typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#elif defined __WIN32__
+typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
 #else
-typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
+typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
 #endif
 
 /*
  * 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.
  */
-
-#if defined __WIN32__
+#ifdef MAC_TCL
+#   define Tcl_ThreadCreateType		pascal void *
+#   define TCL_THREAD_CREATE_RETURN	return NULL
+#elif defined __WIN32__
 #   define Tcl_ThreadCreateType		unsigned __stdcall
 #   define TCL_THREAD_CREATE_RETURN	return 0
 #else
@@ -583,104 +567,103 @@ typedef void (Tcl_ThreadCreateProc) (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_StringCaseMatch.
+ * Flag values passed to Tcl_GetRegExpFromObj.
  */
-
-#define TCL_MATCH_NOCASE	(1<<0)
+#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 */
 
 /*
- * Flag values passed to Tcl_GetRegExpFromObj.
+ * The following flag is experimental and only intended for use by Expect.  It
+ * will probably go away in a later release.
  */
 
-#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_REG_BOSONLY		002000	/* prepend \A to pattern so it only
+					 * matches at the beginning of the
+					 * string. */
 
 /*
  * 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_;
 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 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:
+ * 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:
  *
- * 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.
+ * 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.
  */
 
-#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():
  */
 
@@ -689,17 +672,16 @@ 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. */
@@ -707,104 +689,110 @@ typedef struct Tcl_Value {
 
 /*
  * Forward declaration of Tcl_Obj to prevent an error when the forward
- * reference to Tcl_Obj is encountered in the function types declared below.
+ * reference to Tcl_Obj is encountered in the procedure types declared 
+ * below.
  */
-
 struct Tcl_Obj;
 
 /*
- *----------------------------------------------------------------------------
- * Function types defined by Tcl:
- */
-
-typedef int (Tcl_AppInitProc) (Tcl_Interp *interp);
-typedef int (Tcl_AsyncProc) (ClientData clientData, Tcl_Interp *interp,
-	int code);
-typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
-typedef void (Tcl_CloseProc) (ClientData data);
-typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
-typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
-	int argc, CONST84 char *argv[]);
-typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
-	int level, char *command, Tcl_CmdProc *proc,
-	ClientData cmdClientData, int argc, CONST84 char *argv[]);
-typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
-	int level, const char *command, Tcl_Command commandInfo, int objc,
-	struct Tcl_Obj *const *objv);
-typedef void (Tcl_CmdObjTraceDeleteProc) (ClientData clientData);
-typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
-	struct Tcl_Obj *dupPtr);
-typedef int (Tcl_EncodingConvertProc) (ClientData clientData, const char *src,
-	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
-	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
-typedef void (Tcl_EncodingFreeProc) (ClientData clientData);
-typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags);
-typedef void (Tcl_EventCheckProc) (ClientData clientData, int flags);
-typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, ClientData clientData);
-typedef void (Tcl_EventSetupProc) (ClientData clientData, int flags);
-typedef void (Tcl_ExitProc) (ClientData clientData);
-typedef void (Tcl_FileProc) (ClientData clientData, int mask);
-typedef void (Tcl_FileFreeProc) (ClientData clientData);
-typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr);
-typedef void (Tcl_FreeProc) (char *blockPtr);
-typedef void (Tcl_IdleProc) (ClientData clientData);
-typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
-	Tcl_Interp *interp);
-typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
-	Tcl_Value *args, Tcl_Value *resultPtr);
-typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
-typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
-	int objc, struct Tcl_Obj *const *objv);
-typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
-typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
-typedef void (Tcl_PanicProc) (const char *format, ...);
-typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan,
-	char *address, int port);
-typedef void (Tcl_TimerProc) (ClientData clientData);
-typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
-typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
-typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
-	CONST84 char *part1, CONST84 char *part2, int flags);
-typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
-	const char *oldName, const char *newName, int flags);
-typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
-	ClientData clientData);
-typedef void (Tcl_DeleteFileHandlerProc) (int fd);
-typedef void (Tcl_AlertNotifierProc) (ClientData clientData);
-typedef void (Tcl_ServiceModeHookProc) (int mode);
-typedef ClientData (Tcl_InitNotifierProc) (void);
-typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData);
-typedef void (Tcl_MainLoopProc) (void);
+ * Procedure types defined by Tcl:
+ */
+
+typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int code));
+typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask));
+typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data));
+typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int argc, CONST84 char *argv[]));
+typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
+	ClientData cmdClientData, int argc, CONST84 char *argv[]));
+typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, int level, CONST char *command,
+	Tcl_Command commandInfo, int objc, struct Tcl_Obj * CONST * objv));
+typedef void (Tcl_CmdObjTraceDeleteProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr,
+	struct Tcl_Obj *dupPtr));
+typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData,
+	CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr,
+	char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr,
+	int *dstCharsPtr));
+typedef void (Tcl_EncodingFreeProc)_ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags));
+typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData,
+	int flags));
+typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr,
+	ClientData clientData));
+typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData,
+	int flags));
+typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData, int mask));
+typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
+typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
+typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp));
+typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
+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 void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
+	Tcl_Channel chan, char *address, int port));
+typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
+typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	struct Tcl_Obj *objPtr));
+typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
+typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2,
+	int flags));
+typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData,
+	Tcl_Interp *interp, CONST char *oldName, CONST char *newName,
+	int flags));
+typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask,
+	Tcl_FileProc *proc, ClientData clientData));
+typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd));
+typedef void (Tcl_AlertNotifierProc) _ANSI_ARGS_((ClientData clientData));
+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 functions 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
+ * procedures that provide standard operations on objects of that type.
  */
 
 typedef struct Tcl_ObjType {
-    const char *name;		/* Name of the type, e.g. "int". */
+    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 {
@@ -814,61 +802,98 @@ 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. */
-    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
+    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. */
-	    void *ptr1;
-	    void *ptr2;
+	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 pointer and a long,
-				 *     the main use of which is a bignum's
-				 *     tightly packed fields, where the alloc,
-				 *     used and signum flags are packed into a
-				 *     single word with everything else hung
-				 *     off the pointer. */
-	    void *ptr;
-	    unsigned long value;
-	} 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. Note
- * also that Tcl_DecrRefCount() refers to the parameter "obj" twice. This
- * means that you should avoid calling it with an expression that is expensive
- * to compute or has side effects.
+ * 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. Note also that Tcl_DecrRefCount() refers to the parameter
+ * "obj" twice. This means that you should avoid calling it with an
+ * expression that is expensive to compute or has side effects.
  */
-
-void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
-void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
-int		Tcl_IsShared(Tcl_Obj *objPtr);
+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 { if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr); } while(0)
+#   define Tcl_IsShared(objPtr) \
+	((objPtr)->refCount > 1)
+#endif
+
 /*
- *----------------------------------------------------------------------------
- * 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.
+ * 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.
  */
 
+#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;
@@ -880,48 +905,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;
-				/* Function invoked when deleting the
+    Tcl_NamespaceDeleteProc* deleteProc;
+                                /* Procedure 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.
@@ -931,73 +954,72 @@ typedef struct Tcl_CallFrame {
     Tcl_Namespace *nsPtr;
     int dummy1;
     int dummy2;
-    void *dummy3;
-    void *dummy4;
-    void *dummy5;
+    VOID *dummy3;
+    VOID *dummy4;
+    VOID *dummy5;
     int dummy6;
-    void *dummy7;
-    void *dummy8;
+    VOID *dummy7;
+    VOID *dummy8;
     int dummy9;
-    void *dummy10;
-    void *dummy11;
-    void *dummy12;
-    void *dummy13;
+    VOID *dummy10;
+    VOID *dummy11;
+    VOID *dummy12;
+    VOID *dummy13;
 } Tcl_CallFrame;
 
 /*
- *----------------------------------------------------------------------------
  * Information about commands that is returned by Tcl_GetCommandInfo and
- * 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.
+ * 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.
  */
 
 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 function. */
-    ClientData objClientData;	/* ClientData for object proc. */
-    Tcl_CmdProc *proc;		/* Command's string-based function. */
-    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 procedure. */
+    ClientData objClientData;	 /* ClientData for object proc. */
+    Tcl_CmdProc *proc;		 /* Command's string-based procedure. */
+    ClientData clientData;	 /* ClientData for string proc. */
     Tcl_CmdDeleteProc *deleteProc;
-				/* 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. */
+                                 /* 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. */
+
 } Tcl_CmdInfo;
 
 /*
- *----------------------------------------------------------------------------
- * 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.
+ * 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.  
  */
 
 #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)
@@ -1005,34 +1027,29 @@ 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 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.
+ * 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).
  */
 
 #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
@@ -1042,47 +1059,26 @@ typedef struct Tcl_DString {
 #define TCL_EXACT	1
 
 /*
- *----------------------------------------------------------------------------
- * 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.
- *	TCL_CANCEL_UNWIND:	Magical Tcl_CancelEval mode that causes the
- *				stack for the script in progress to be
- *				completely unwound.
- *	TCL_EVAL_NOERR:	Do no exception reporting at all, just return
- *				as the caller will report.
+ * 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!!
  */
-
-#define TCL_NO_EVAL		0x010000
-#define TCL_EVAL_GLOBAL		0x020000
-#define TCL_EVAL_DIRECT		0x040000
-#define TCL_EVAL_INVOKE		0x080000
-#define TCL_CANCEL_UNWIND	0x100000
-#define TCL_EVAL_NOERR          0x200000
+#define TCL_NO_EVAL		0x10000
+#define TCL_EVAL_GLOBAL		0x20000
+#define TCL_EVAL_DIRECT		0x40000
+#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 functions.
- * WARNING: these bit choices must not conflict with the bit choice for
- * TCL_CANCEL_UNWIND, above.
+ * Flag values passed to variable-related procedures.
  */
 
 #define TCL_GLOBAL_ONLY		 1
@@ -1097,63 +1093,52 @@ typedef struct Tcl_DString {
 #define TCL_LEAVE_ERR_MSG	 0x200
 #define TCL_TRACE_ARRAY		 0x800
 #ifndef TCL_REMOVE_OBSOLETE_TRACES
-/* Required to support old variable/vdelete/vinfo traces. */
+/* Required to support old variable/vdelete/vinfo traces */
 #define TCL_TRACE_OLD_STYLE	 0x1000
 #endif
-/* Indicate the semantics of the result of a trace. */
+/* Indicate the semantics of the result of a trace */
 #define TCL_TRACE_RESULT_DYNAMIC 0x8000
 #define TCL_TRACE_RESULT_OBJECT  0x10000
 
 /*
- * 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.
+ * Flag values passed to command-related procedures.
  */
 
-#define TCL_TRACE_RENAME	0x2000
-#define TCL_TRACE_DELETE	0x4000
+#define TCL_TRACE_RENAME 0x2000
+#define TCL_TRACE_DELETE 0x4000
 
 #define TCL_ALLOW_INLINE_COMPILATION 0x20000
 
 /*
- * 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)
+ * 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)
  */
+#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
-
+
 /*
- *----------------------------------------------------------------------------
  * Forward declarations of Tcl_HashTable and related types.
  */
 
@@ -1161,18 +1146,20 @@ typedef struct Tcl_HashKeyType Tcl_HashKeyType;
 typedef struct Tcl_HashTable Tcl_HashTable;
 typedef struct Tcl_HashEntry Tcl_HashEntry;
 
-typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
-typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
-typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
-	void *keyPtr);
-typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);
+typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+	VOID *keyPtr));
+typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr,
+	Tcl_HashEntry *hPtr));
+typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) _ANSI_ARGS_((
+	Tcl_HashTable *tablePtr, VOID *keyPtr));
+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
@@ -1180,152 +1167,160 @@ typedef void (Tcl_FreeHashEntryProc) (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
-    void *hash;			/* Hash value, stored as pointer to ensure
-				 * that the offsets of the fields in this
-				 * structure are not changed. */
+#   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
 #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[1];		/* 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;
-				/* Calculates a hash value for the key. If
-				 * this is NULL then the pointer itself is
-				 * used as a hash value. */
+
+    /* 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_CompareHashKeysProc *compareKeysProc;
-				/* 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. */
+
+    /* 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_AllocHashEntryProc *allocEntryProc;
-				/* 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. */
+
+    /* 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.
+     */
     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. */
-    Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key);
-    Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key,
-	    int *newPtr);
-    const Tcl_HashKeyType *typePtr;
-				/* Type of the keys used in the
-				 * Tcl_HashTable. */
+					/* 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
+    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. */
 };
 
 /*
- * 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 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
+					 * 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
@@ -1333,40 +1328,69 @@ 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
+
+/*
+ * Macros for clients to use to access fields of hash entries:
  */
 
-#define TCL_STRING_KEYS		(0)
-#define TCL_ONE_WORD_KEYS	(1)
-#define TCL_CUSTOM_TYPE_KEYS	(-2)
-#define TCL_CUSTOM_PTR_KEYS	(-1)
+#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
 
 /*
- * Structure definition for information used to keep track of searches through
- * dictionaries. These fields should not be accessed by code outside
- * tclDictObj.c
+ * 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 */
 /*
- *----------------------------------------------------------------------------
- * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of
- * events:
+ * Macro to use new extended version of Tcl_InitHashTable.
  */
+#   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)
@@ -1375,16 +1399,17 @@ typedef struct {
 #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;	/* Function to call to service this event. */
+    Tcl_EventProc *proc;	/* Procedure to call to service this event. */
     struct Tcl_Event *nextPtr;	/* Next in list of pending events, or NULL. */
 };
 
@@ -1405,9 +1430,10 @@ 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.
+ * On Macintosh systems the epoch is Midnight Jan 1, 1904 GMT.
  */
 
 typedef struct Tcl_Time {
@@ -1415,33 +1441,24 @@ typedef struct Tcl_Time {
     long usec;			/* Microseconds. */
 } Tcl_Time;
 
-typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
-typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);
-
-/*
- * TIP #233 (Virtualized Time)
- */
-
-typedef void (Tcl_GetTimeProc)   (Tcl_Time *timebuf, ClientData clientData);
-typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
+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:
+ * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler
+ * to indicate what sorts of events are of interest:
  */
-
-#define TCL_READABLE		(1<<1)
-#define TCL_WRITABLE		(1<<2)
-#define TCL_EXCEPTION		(1<<3)
+#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.
+ * 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_STDIN		(1<<1)	
 #define TCL_STDOUT		(1<<2)
 #define TCL_STDERR		(1<<3)
 #define TCL_ENFORCE_MODE	(1<<4)
@@ -1450,29 +1467,27 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
  * 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)
@@ -1482,135 +1497,153 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, ClientData clientData);
  * Typedefs for the various operations in a channel type:
  */
 
-typedef int	(Tcl_DriverBlockModeProc) (ClientData instanceData, int mode);
-typedef int	(Tcl_DriverCloseProc) (ClientData instanceData,
-			Tcl_Interp *interp);
-typedef int	(Tcl_DriverClose2Proc) (ClientData instanceData,
-			Tcl_Interp *interp, int flags);
-typedef int	(Tcl_DriverInputProc) (ClientData instanceData, char *buf,
-			int toRead, int *errorCodePtr);
-typedef int	(Tcl_DriverOutputProc) (ClientData instanceData,
-			CONST84 char *buf, int toWrite, int *errorCodePtr);
-typedef int	(Tcl_DriverSeekProc) (ClientData instanceData, long offset,
-			int mode, int *errorCodePtr);
-typedef int	(Tcl_DriverSetOptionProc) (ClientData instanceData,
-			Tcl_Interp *interp, const char *optionName,
-			const char *value);
-typedef int	(Tcl_DriverGetOptionProc) (ClientData instanceData,
-			Tcl_Interp *interp, CONST84 char *optionName,
-			Tcl_DString *dsPtr);
-typedef void	(Tcl_DriverWatchProc) (ClientData instanceData, int mask);
-typedef int	(Tcl_DriverGetHandleProc) (ClientData instanceData,
-			int direction, ClientData *handlePtr);
-typedef int	(Tcl_DriverFlushProc) (ClientData instanceData);
-typedef int	(Tcl_DriverHandlerProc) (ClientData instanceData,
-			int interestMask);
-typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData,
-			Tcl_WideInt offset, int mode, int *errorCodePtr);
-/*
- * TIP #218, Channel Thread Actions
- */
-typedef void	(Tcl_DriverThreadActionProc) (ClientData instanceData,
-			int action);
-/*
- * TIP #208, File Truncation (etc.)
- */
-typedef int	(Tcl_DriverTruncateProc) (ClientData instanceData,
-			Tcl_WideInt length);
+typedef int	(Tcl_DriverBlockModeProc) _ANSI_ARGS_((
+		    ClientData instanceData, int mode));
+typedef int	(Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
+		    Tcl_Interp *interp));
+typedef int	(Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData,
+		    Tcl_Interp *interp, int flags));
+typedef int	(Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
+		    char *buf, int toRead, int *errorCodePtr));
+typedef int	(Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
+		    CONST84 char *buf, int toWrite, int *errorCodePtr));
+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));
+typedef int	(Tcl_DriverGetOptionProc) _ANSI_ARGS_((
+		    ClientData instanceData, Tcl_Interp *interp,
+		    CONST84 char *optionName, Tcl_DString *dsPtr));
+typedef void	(Tcl_DriverWatchProc) _ANSI_ARGS_((
+		    ClientData instanceData, int mask));
+typedef int	(Tcl_DriverGetHandleProc) _ANSI_ARGS_((
+		    ClientData instanceData, int direction,
+		    ClientData *handlePtr));
+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.
+ */
+#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.
+ */
+#   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 */
 
 /*
  * 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 {
-    const 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. */
+    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. */
     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;
-				/* Function 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;	/* Procedure 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;
-				/* 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. */
+    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. */
     /*
-     * Only valid in TCL_CHANNEL_VERSION_3 channels or later.
+     * Only valid in TCL_CHANNEL_VERSION_3 channels or later
      */
     Tcl_DriverWideSeekProc *wideSeekProc;
-				/* 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. */
+					/* 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. */
 } 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 function 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 procedure in the above structure.
  */
-
 #define TCL_MODE_BLOCKING	0	/* Put channel into blocking mode. */
 #define TCL_MODE_NONBLOCKING	1	/* Put channel into nonblocking
 					 * mode. */
 
 /*
- *----------------------------------------------------------------------------
  * Enum for different types of file paths.
  */
 
@@ -1620,20 +1653,23 @@ 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 {
-    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. */
+    /* 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;
 } Tcl_GlobTypeData;
 
 /*
- * Type and permission definitions for glob command.
+ * type and permission definitions for glob command
  */
 
 #define TCL_GLOB_TYPE_BLOCK		(1<<0)
@@ -1652,251 +1688,283 @@ 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) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-typedef int (Tcl_FSAccessProc) (Tcl_Obj *pathPtr, int mode);
-typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) (Tcl_Interp *interp,
-	Tcl_Obj *pathPtr, int mode, int permissions);
-typedef int (Tcl_FSMatchInDirectoryProc) (Tcl_Interp *interp, Tcl_Obj *result,
-	Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types);
-typedef Tcl_Obj * (Tcl_FSGetCwdProc) (Tcl_Interp *interp);
-typedef int (Tcl_FSChdirProc) (Tcl_Obj *pathPtr);
-typedef int (Tcl_FSLstatProc) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-typedef int (Tcl_FSCreateDirectoryProc) (Tcl_Obj *pathPtr);
-typedef int (Tcl_FSDeleteFileProc) (Tcl_Obj *pathPtr);
-typedef int (Tcl_FSCopyDirectoryProc) (Tcl_Obj *srcPathPtr,
-	Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
-typedef int (Tcl_FSCopyFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
-typedef int (Tcl_FSRemoveDirectoryProc) (Tcl_Obj *pathPtr, int recursive,
-	Tcl_Obj **errorPtr);
-typedef int (Tcl_FSRenameFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
-typedef void (Tcl_FSUnloadFileProc) (Tcl_LoadHandle loadHandle);
-typedef Tcl_Obj * (Tcl_FSListVolumesProc) (void);
+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, 
+	Tcl_GlobTypeData * types));
+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_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));
+typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+			    Tcl_Obj *destPathPtr));
+typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
+			    int recursive, Tcl_Obj **errorPtr));
+typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+			    Tcl_Obj *destPathPtr));
+typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
+typedef Tcl_Obj* (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
 /* We have to declare the utime structure here. */
 struct utimbuf;
-typedef int (Tcl_FSUtimeProc) (Tcl_Obj *pathPtr, struct utimbuf *tval);
-typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
-	int nextCheckpoint);
-typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index,
-	Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
-typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
-	Tcl_Obj **objPtrRef);
-typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
-	Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
-typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
-	int linkType);
-typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
-	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
-typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr,
-	ClientData *clientDataPtr);
-typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr);
-typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr);
-typedef void (Tcl_FSFreeInternalRepProc) (ClientData clientData);
-typedef ClientData (Tcl_FSDupInternalRepProc) (ClientData clientData);
-typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (ClientData clientData);
-typedef ClientData (Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr);
+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));
+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));
+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 struct Tcl_FSVersion_ *Tcl_FSVersion;
 
 /*
- *----------------------------------------------------------------------------
+ *----------------------------------------------------------------
  * Data structures related to hooking into the filesystem
+ *----------------------------------------------------------------
  */
 
 /*
  * Filesystem version tag.  This was introduced in 8.4.
  */
-
 #define TCL_FILESYSTEM_VERSION_1	((Tcl_FSVersion) 0x1)
 
 /*
  * 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 function. */
+			    /* Function to check whether a path is in 
+			     * this filesystem.  This is the most
+			     * important filesystem procedure. */
     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 {
@@ -1909,99 +1977,165 @@ typedef struct Tcl_NotifierProcs {
     Tcl_AlertNotifierProc *alertNotifierProc;
     Tcl_ServiceModeHookProc *serviceModeHookProc;
 } Tcl_NotifierProcs;
-
+
+/*
+ * 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".
+				 * This name is the unique key for this
+				 * encoding type. */
+    Tcl_EncodingConvertProc *toUtfProc;
+				/* Procedure to convert from external
+				 * encoding into UTF-8. */
+    Tcl_EncodingConvertProc *fromUtfProc;
+				/* Procedure to convert from UTF-8 into
+				 * external encoding. */
+    Tcl_EncodingFreeProc *freeProc;
+				/* If non-NULL, procedure to call when this
+				 * encoding is deleted. */
+    ClientData clientData;	/* Arbitrary value associated with encoding
+				 * type.  Passed to conversion procedures. */
+    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;    
+
 /*
- *----------------------------------------------------------------------------
- * The following data structures and declarations are for the new Tcl parser.
+ * The following definitions are used as values for the conversion control
+ * flags argument when converting text from one character set to another:
  *
- * 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.
+ * 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
+ *				initialization that needs to occur before the
+ *				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
+ *				block in a (potentially multi-block) input
+ *				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
+ *				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.
+ */
+#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.
+ */
+
+/*
+ * 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. */
-    const char *start;		/* First character in token. */
+    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.
- * TCL_TOKEN_COMMAND -		The token describes a command whose result
- *				must be substituted into the word. The token
- *				includes the enclosing brackets. NumComponents
+ *				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_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_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,
  *				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 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
+ *				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
  *				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.
- * 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.
+ *				subexpression, and is followed by zero or
+ *				more TCL_TOKEN_SUB_EXPR tokens for the
+ *				operator's operands. NumComponents is
+ *				always 0.
  */
-
 #define TCL_TOKEN_WORD		1
 #define TCL_TOKEN_SIMPLE_WORD	2
 #define TCL_TOKEN_TEXT		4
@@ -2010,11 +2144,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
@@ -2029,32 +2163,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. */
-    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
+    CONST char *commentStart;	/* Pointer to # that begins the first of
+				 * one or more comments preceding the
 				 * 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 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. */
     int numTokens;		/* Total number of tokens in command. */
     int tokensAvailable;	/* Total number of tokens available at
 				 * *tokenPtr. */
@@ -2062,137 +2196,81 @@ typedef struct Tcl_Parse {
 				 * above. */
 
     /*
-     * The fields below are intended only for the private use of the parser.
-     * They should not be used by functions that invoke Tcl_ParseCommand.
+     * The fields below are intended only for the private use of the
+     * parser.	They should not be used by procedures that invoke
+     * Tcl_ParseCommand.
      */
 
-    const char *string;		/* The original command string passed to
+    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 *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). */
+    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). */
     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 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".
-				 * This name is the unique key for this
-				 * encoding type. */
-    Tcl_EncodingConvertProc *toUtfProc;
-				/* Function to convert from external encoding
-				 * into UTF-8. */
-    Tcl_EncodingConvertProc *fromUtfProc;
-				/* Function to convert from UTF-8 into
-				 * external encoding. */
-    Tcl_EncodingFreeProc *freeProc;
-				/* If non-NULL, function to call when this
-				 * encoding is deleted. */
-    ClientData clientData;	/* Arbitrary value associated with encoding
-				 * 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;
-
-/*
- * 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
- *				block in a (potentially multi-block) input
- *				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
- *				converted, this flag should be set.
- * TCL_ENCODING_END -		Signifies that the source buffer is the last
- *				block in a (potentially multi-block) input
- *				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
- *				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
- *				convert the source.
- */
-
-#define TCL_ENCODING_START		0x01
-#define TCL_ENCODING_END		0x02
-#define TCL_ENCODING_STOPONERROR	0x04
 
 /*
  * 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, 4 or 6
- * (or perhaps 1 if we want to support a non-unicode enabled core). If 3 or
- * 4, 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.
+ * 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.
  */
 
 #ifndef TCL_UTF_MAX
@@ -2200,15 +2278,15 @@ typedef struct Tcl_EncodingType {
 #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
@@ -2218,407 +2296,111 @@ typedef unsigned int Tcl_UniChar;
 #else
 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;
-
-/*
- *----------------------------------------------------------------------------
- * Flags for TIP#143 limits, detailing which limits are active in an
- * interpreter. Used for Tcl_{Add,Remove}LimitHandler type argument.
- */
-
-#define TCL_LIMIT_COMMANDS	0x01
-#define TCL_LIMIT_TIME		0x02
-
-/*
- * 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) (ClientData clientData, Tcl_Interp *interp);
-typedef void (Tcl_LimitHandlerDeleteProc) (ClientData clientData);
-
-/*
- *----------------------------------------------------------------------------
- * Override definitions for libtommath.
- */
-
-typedef struct mp_int mp_int;
-#define MP_INT_DECLARED
-typedef unsigned int mp_digit;
-#define MP_DIGIT_DECLARED
-
-/*
- *----------------------------------------------------------------------------
- * Definitions needed for Tcl_ParseArgvObj routines.
- * Based on tkArgv.c.
- * Modifications from the original are copyright (c) Sam Bromley 2006
- */
-
-typedef struct {
-    int type;			/* Indicates the option type; see below. */
-    const char *keyStr;		/* The key string that flags the option in the
-				 * argv array. */
-    void *srcPtr;		/* Value to be used in setting dst; usage
-				 * depends on type.*/
-    void *dstPtr;		/* Address of value to be modified; usage
-				 * depends on type.*/
-    const char *helpStr;	/* Documentation message describing this
-				 * option. */
-    ClientData clientData;	/* Word to pass to function callbacks. */
-} Tcl_ArgvInfo;
-
-/*
- * Legal values for the type field of a Tcl_ArgInfo: see the user
- * documentation for details.
- */
-
-#define TCL_ARGV_CONSTANT	15
-#define TCL_ARGV_INT		16
-#define TCL_ARGV_STRING		17
-#define TCL_ARGV_REST		18
-#define TCL_ARGV_FLOAT		19
-#define TCL_ARGV_FUNC		20
-#define TCL_ARGV_GENFUNC	21
-#define TCL_ARGV_HELP		22
-#define TCL_ARGV_END		23
-
-/*
- * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
- * argument types:
- */
-
-typedef int (Tcl_ArgvFuncProc)(ClientData clientData, Tcl_Obj *objPtr,
-	void *dstPtr);
-typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
-	int objc, Tcl_Obj *const *objv, void *dstPtr);
-
-/*
- * Shorthand for commonly used argTable entries.
- */
-
-#define TCL_ARGV_AUTO_HELP \
-    {TCL_ARGV_HELP,	"-help",	NULL,	NULL, \
-	    "Print summary of command-line options and abort", NULL}
-#define TCL_ARGV_AUTO_REST \
-    {TCL_ARGV_REST,	"--",		NULL,	NULL, \
-	    "Marks the end of the options", NULL}
-#define TCL_ARGV_TABLE_END \
-    {TCL_ARGV_END, NULL, NULL, NULL, NULL, NULL}
-
-/*
- *----------------------------------------------------------------------------
- * Definitions needed for Tcl_Zlib routines. [TIP #234]
- *
- * Constants for the format flags describing what sort of data format is
- * desired/expected for the Tcl_ZlibDeflate, Tcl_ZlibInflate and
- * Tcl_ZlibStreamInit functions.
- */
-
-#define TCL_ZLIB_FORMAT_RAW	1
-#define TCL_ZLIB_FORMAT_ZLIB	2
-#define TCL_ZLIB_FORMAT_GZIP	4
-#define TCL_ZLIB_FORMAT_AUTO	8
-
-/*
- * Constants that describe whether the stream is to operate in compressing or
- * decompressing mode.
- */
-
-#define TCL_ZLIB_STREAM_DEFLATE	16
-#define TCL_ZLIB_STREAM_INFLATE	32
-
-/*
- * Constants giving compression levels. Use of TCL_ZLIB_COMPRESS_DEFAULT is
- * recommended.
- */
 
-#define TCL_ZLIB_COMPRESS_NONE	0
-#define TCL_ZLIB_COMPRESS_FAST	1
-#define TCL_ZLIB_COMPRESS_BEST	9
-#define TCL_ZLIB_COMPRESS_DEFAULT (-1)
 
 /*
- * Constants for types of flushing, used with Tcl_ZlibFlush.
+ * Deprecated Tcl procedures:
  */
+#ifndef TCL_NO_DEPRECATED
+#   define Tcl_EvalObj(interp,objPtr) \
+	Tcl_EvalObjEx((interp),(objPtr),0)
+#   define Tcl_GlobalEvalObj(interp,objPtr) \
+	Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+#endif
 
-#define TCL_ZLIB_NO_FLUSH	0
-#define TCL_ZLIB_FLUSH		2
-#define TCL_ZLIB_FULLFLUSH	3
-#define TCL_ZLIB_FINALIZE	4
 
 /*
- *----------------------------------------------------------------------------
- * Single public declaration for NRE.
+ * These function have been renamed. The old names are deprecated, but we
+ * define these macros for backwards compatibilty.
  */
-
-typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
-				int result);
+#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
 
 /*
- *----------------------------------------------------------------------------
- * The following constant is used to test for older versions of Tcl in the
- * stubs tables.
+ * 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.
  */
 
-const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
-			    int exact);
-const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
-			    const char *version, int epoch, int revision);
-
-/*
- * When not using stubs, make it a macro.
- */
+EXTERN CONST char *	Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
+			    CONST char *version, int exact));
 
 #ifndef USE_TCL_STUBS
-#define Tcl_InitStubs(interp, version, exact) \
-    Tcl_PkgInitStubsCheck(interp, version, exact)
-#endif
 
 /*
- * TODO - tommath stubs export goes here!
+ * When not using stubs, make it a macro.
  */
 
-/*
- * Public functions that are not accessible via the stubs table.
- * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
- */
+#define Tcl_InitStubs(interp, version, exact) \
+    Tcl_PkgRequire(interp, "Tcl", version, exact)
 
-#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
-EXTERN void		Tcl_MainEx(int argc, char **argv,
-			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
-EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
-			    const char *version, int exact);
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
 #endif
-
-/*
- *----------------------------------------------------------------------------
- * 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 the public function declarations that are accessible via
+ * the stubs table.
  */
 
-#include "tclPlatDecls.h"
+#include "tclDecls.h"
 
 /*
- *----------------------------------------------------------------------------
- * 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.
+ * Include platform specific public function declarations that are
+ * accessible via the stubs table.
  */
 
-#ifdef TCL_MEM_DEBUG
-
-#   define ckalloc(x) \
-    ((VOID *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__))
-#   define ckfree(x) \
-    Tcl_DbCkfree((char *)(x), __FILE__, __LINE__)
-#   define ckrealloc(x,y) \
-    ((VOID *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__))
-#   define attemptckalloc(x) \
-    ((VOID *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__))
-#   define attemptckrealloc(x,y) \
-    ((VOID *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(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.
+ * tclPlatDecls.h can't be included here on the Mac, as we need
+ * Mac specific headers to define the Mac types used in this file,
+ * but these Mac haders conflict with a number of tk types
+ * and thus can't be included in the globally read tcl.h
+ * This header was originally added here as a fix for bug 5241
+ * (stub link error for symbols in TclPlatStubs table), as a work-
+ * around for the bug on the mac, tclMac.h is included immediately 
+ * after tcl.h in the tcl precompiled header (with DLLEXPORT set).
  */
 
-#   define ckalloc(x) \
-    ((VOID *) Tcl_Alloc((unsigned)(x)))
-#   define ckfree(x) \
-    Tcl_Free((char *)(x))
-#   define ckrealloc(x,y) \
-    ((VOID *) Tcl_Realloc((char *)(x), (unsigned)(y)))
-#   define attemptckalloc(x) \
-    ((VOID *) Tcl_AttemptAlloc((unsigned)(x)))
-#   define attemptckrealloc(x,y) \
-    ((VOID *) Tcl_AttemptRealloc((char *)(x), (unsigned)(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 { if (--(objPtr)->refCount <= 0) TclFreeObj(objPtr); } while(0)
-#   define Tcl_IsShared(objPtr) \
-	((objPtr)->refCount > 1)
+#if !defined(MAC_TCL)
+#include "tclPlatDecls.h"
 #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) \
-	((void *) (((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, (const char *)(key))
-#undef  Tcl_CreateHashEntry
-#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
-	(*((tablePtr)->createProc))(tablePtr, (const char *)(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 */
-
-/*
- *----------------------------------------------------------------------------
- * Deprecated Tcl functions:
+ * Public functions that are not accessible via the stubs table.
  */
 
-#ifndef TCL_NO_DEPRECATED
-#   undef  Tcl_EvalObj
-#   define Tcl_EvalObj(interp,objPtr) \
-	Tcl_EvalObjEx((interp),(objPtr),0)
-#   undef  Tcl_GlobalEvalObj
-#   define Tcl_GlobalEvalObj(interp,objPtr) \
-	Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
+	Tcl_AppInitProc *appInitProc));
 
 /*
- * These function have been renamed. The old names are deprecated, but we
- * define these macros for backwards compatibilty.
+ * 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
  */
 
-#   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 /* !TCL_NO_DEPRECATED */
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS
 
-/*
- *----------------------------------------------------------------------------
- * 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.
- */
+EXTERN int		Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
 
-extern Tcl_AppInitProc Tcl_AppInit;
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
 
 #endif /* RC_INVOKED */
 
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index ae61e85..7b9c807 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,58 +21,69 @@
  * that has significantly reduced lock contention.
  */
 
+#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC) || defined(TCL_MEM_DEBUG)
+
 #include "tclInt.h"
-#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
+#include "tclPort.h"
 
 #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__)
+#if defined(MAC_TCL) || defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
 typedef unsigned long caddr_t;
 #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.
+ * 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.
  */
 
 union overhead {
-    union overhead *next;		/* when free */
-    unsigned char padding[TCL_ALLOCALIGN];	/* align struct to TCL_ALLOCALIGN bytes */
+    union overhead *ov_next;		/* when free */
+    unsigned char ov_padding[ALLOCALIGN];/* align struct to ALLOCALIGN bytes */
     struct {
-	unsigned char magic0;		/* magic number */
-	unsigned char index;		/* bucket # */
-	unsigned char unused;		/* unused */
-	unsigned char magic1;		/* other magic number */
+	unsigned char	ovu_magic0;	/* magic number */
+	unsigned char	ovu_index;	/* bucket # */
+	unsigned char	ovu_unused;	/* unused */
+	unsigned char	ovu_magic1;	/* other magic number */
 #ifndef NDEBUG
-	unsigned short rmagic;		/* range magic number */
-	unsigned long size;		/* actual block size */
-	unsigned short unused2;		/* padding to 8-byte align */
+	unsigned short	ovu_rmagic;	/* range magic number */
+	unsigned long	ovu_size;	/* actual block size */
+	unsigned short  ovu_unused2;    /* padding to 8-byte align */
 #endif
     } ovu;
-#define overMagic0	ovu.magic0
-#define overMagic1	ovu.magic1
-#define bucketIndex	ovu.index
-#define rangeCheckMagic	ovu.rmagic
-#define realBlockSize	ovu.size
+#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 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)
+#define	RSLOP		sizeof (unsigned short)
 #else
 #define	RSLOP		0
 #endif
@@ -80,45 +91,38 @@ union overhead {
 #define OVERHEAD (sizeof(union overhead) + RSLOP)
 
 /*
- * 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
+ * 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) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
+#define MINBLOCK	((sizeof(union overhead) + (ALLOCALIGN-1)) & ~(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
@@ -126,19 +130,21 @@ static Tcl_Mutex *allocMutexPtr;
 #endif
 static int allocInit = 0;
 
+
 #ifdef MSTATS
 
 /*
- * numMallocs[i] is the difference between the number of mallocs and frees for
- * a given block size.
+ * nmalloc[i] is the difference between the number of mallocs and frees
+ * for a given block size.
  */
 
-static	unsigned int numMallocs[NBUCKETS+1];
+static	unsigned int nmalloc[NBUCKETS+1];
+#include <stdio.h>
 #endif
 
 #if !defined(NDEBUG)
-#define	ASSERT(p)	if (!(p)) Tcl_Panic(# p)
-#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
+#define	ASSERT(p)   if (!(p)) panic(# p)
+#define RANGE_ASSERT(p) if (!(p)) panic(# p)
 #else
 #define	ASSERT(p)
 #define RANGE_ASSERT(p)
@@ -148,7 +154,8 @@ static	unsigned int numMallocs[NBUCKETS+1];
  * Prototypes for functions used only in this file.
  */
 
-static void		MoreCore(int bucket);
+static void 		MoreCore _ANSI_ARGS_((int bucket));
+
 
 /*
  *-------------------------------------------------------------------------
@@ -167,7 +174,7 @@ static void		MoreCore(int bucket);
  */
 
 void
-TclInitAlloc(void)
+TclInitAlloc()
 {
     if (!allocInit) {
 	allocInit = 1;
@@ -182,26 +189,27 @@ TclInitAlloc(void)
  *
  * 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(void)
+TclFinalizeAllocSubsystem()
 {
     unsigned int i;
     struct block *blockPtr, *nextPtr;
@@ -221,14 +229,14 @@ TclFinalizeAllocSubsystem(void)
     bigBlocks.nextPtr = &bigBlocks;
     bigBlocks.prevPtr = &bigBlocks;
 
-    for (i=0 ; i<NBUCKETS ; i++) {
+    for (i = 0; i < NBUCKETS; i++) {
 	nextf[i] = NULL;
 #ifdef MSTATS
-	numMallocs[i] = 0;
+	nmalloc[i] = 0;
 #endif
     }
 #ifdef MSTATS
-    numMallocs[i] = 0;
+    nmalloc[i] = 0;
 #endif
     Tcl_MutexUnlock(allocMutexPtr);
 }
@@ -250,32 +258,30 @@ TclFinalizeAllocSubsystem(void)
  */
 
 char *
-TclpAlloc(
-    unsigned int numBytes)	/* Number of bytes to allocate. */
+TclpAlloc(nbytes)
+    unsigned int nbytes;	/* Number of bytes to allocate. */
 {
-    register union overhead *overPtr;
+    register union overhead *op;
     register long bucket;
-    register unsigned amount;
+    register unsigned amt;
     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 (numBytes >= MAXMALLOC - OVERHEAD) {
-	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
-	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
-		    (sizeof(struct block) + OVERHEAD + numBytes), 0);
+    if (nbytes >= MAXMALLOC - OVERHEAD) {
+	if (nbytes <= UINT_MAX - OVERHEAD - sizeof(struct block)) {
+	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) 
+		    (sizeof(struct block) + OVERHEAD + nbytes), 0);
 	}
 	if (bigBlockPtr == NULL) {
 	    Tcl_MutexUnlock(allocMutexPtr);
@@ -286,83 +292,74 @@ TclpAlloc(
 	bigBlockPtr->prevPtr = &bigBlocks;
 	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;
 
-	overPtr = (union overhead *) (bigBlockPtr + 1);
-	overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
-	overPtr->bucketIndex = 0xff;
+	op = (union overhead *) (bigBlockPtr + 1);
+	op->ov_magic0 = op->ov_magic1 = MAGIC;
+	op->ov_index = 0xff;
 #ifdef MSTATS
-	numMallocs[NBUCKETS]++;
+	nmalloc[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.
 	 */
-
-	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-	overPtr->rangeCheckMagic = RMAGIC;
-	BLOCK_END(overPtr) = RMAGIC;
+	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+	op->ov_rmagic = RMAGIC;
+	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-
 	Tcl_MutexUnlock(allocMutexPtr);
-	return (void *)(overPtr+1);
+	return (void *)(op+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.
      */
 
-    amount = MINBLOCK;		/* size of first bucket */
+    amt = MINBLOCK;		/* size of first bucket */
     bucket = MINBLOCK >> 4;
 
-    while (numBytes + OVERHEAD > amount) {
-	amount <<= 1;
-	if (amount == 0) {
+    while (nbytes + OVERHEAD > amt) {
+	amt <<= 1;
+	if (amt == 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 ((overPtr = nextf[bucket]) == NULL) {
+    if ((op = nextf[bucket]) == NULL) {
 	MoreCore(bucket);
-	if ((overPtr = nextf[bucket]) == NULL) {
+	if ((op = nextf[bucket]) == NULL) {
 	    Tcl_MutexUnlock(allocMutexPtr);
-	    return NULL;
+	    return (NULL);
 	}
     }
-
     /*
      * Remove from linked list
      */
-
-    nextf[bucket] = overPtr->next;
-    overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
-    overPtr->bucketIndex = (unsigned char) bucket;
-
+    nextf[bucket] = op->ov_next;
+    op->ov_magic0 = op->ov_magic1 = MAGIC;
+    op->ov_index = (unsigned char) bucket;
 #ifdef MSTATS
-    numMallocs[bucket]++;
+    nmalloc[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.
      */
-
-    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-    overPtr->rangeCheckMagic = RMAGIC;
-    BLOCK_END(overPtr) = RMAGIC;
+    op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+    op->ov_rmagic = RMAGIC;
+    *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-
     Tcl_MutexUnlock(allocMutexPtr);
-    return ((char *)(overPtr + 1));
+    return ((char *)(op + 1));
 }
 
 /*
@@ -384,29 +381,28 @@ TclpAlloc(
  */
 
 static void
-MoreCore(
-    int bucket)			/* What bucket to allocat to. */
+MoreCore(bucket)
+    int bucket;		/* What bucket to allocat to. */
 {
-    register union overhead *overPtr;
-    register long size;		/* size of desired block */
-    long amount;		/* amount to allocate */
-    int numBlocks;		/* how many blocks we get */
+    register union overhead *op;
+    register long sz;		/* size of desired block */
+    long amt;			/* amount to allocate */
+    int nblks;			/* 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);
 
-    size = 1 << (bucket + 3);
-    ASSERT(size > 0);
+    amt = MAXMALLOC;
+    nblks = amt / sz;
+    ASSERT(nblks*sz == amt);
 
-    amount = MAXMALLOC;
-    numBlocks = amount / size;
-    ASSERT(numBlocks*size == amount);
-
-    blockPtr = (struct block *) TclpSysAlloc((unsigned)
-	    (sizeof(struct block) + amount), 1);
+    blockPtr = (struct block *) TclpSysAlloc((unsigned) 
+	    (sizeof(struct block) + amt), 1);
     /* no more room! */
     if (blockPtr == NULL) {
 	return;
@@ -414,18 +410,18 @@ MoreCore(
     blockPtr->nextPtr = blockList;
     blockList = blockPtr;
 
-    overPtr = (union overhead *) (blockPtr + 1);
-
+    op = (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] = overPtr;
-    while (--numBlocks > 0) {
-	overPtr->next = (union overhead *)((caddr_t)overPtr + size);
-	overPtr = (union overhead *)((caddr_t)overPtr + size);
+    nextf[bucket] = op;
+    while (--nblks > 0) {
+	op->ov_next = (union overhead *)((caddr_t)op + sz);
+	op = (union overhead *)((caddr_t)op + sz);
     }
-    overPtr->next = NULL;
+    op->ov_next = (union overhead *)NULL;
 }
 
 /*
@@ -445,51 +441,47 @@ MoreCore(
  */
 
 void
-TclpFree(
-    char *oldPtr)		/* Pointer to memory to free. */
-{
+TclpFree(cp)
+    char *cp;		/* Pointer to memory to free. */
+{   
     register long size;
-    register union overhead *overPtr;
+    register union overhead *op;
     struct block *bigBlockPtr;
 
-    if (oldPtr == NULL) {
+    if (cp == NULL) {
 	return;
     }
 
     Tcl_MutexLock(allocMutexPtr);
-    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
+    op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
 
-    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
-    ASSERT(overPtr->overMagic1 == MAGIC);
-    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
+    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) {
 	Tcl_MutexUnlock(allocMutexPtr);
 	return;
     }
 
-    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
-    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
-    size = overPtr->bucketIndex;
-    if (size == 0xff) {
+    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 ) {
 #ifdef MSTATS
-	numMallocs[NBUCKETS]--;
+	nmalloc[NBUCKETS]--;
 #endif
-
-	bigBlockPtr = (struct block *) overPtr - 1;
+	bigBlockPtr = (struct block *) op - 1;
 	bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
 	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
 	TclpSysFree(bigBlockPtr);
-
 	Tcl_MutexUnlock(allocMutexPtr);
 	return;
     }
     ASSERT(size < NBUCKETS);
-    overPtr->next = nextf[size];	/* also clobbers overMagic */
-    nextf[size] = overPtr;
-
+    op->ov_next = nextf[size];	/* also clobbers ov_magic */
+    nextf[size] = op;
 #ifdef MSTATS
-    numMallocs[size]--;
+    nmalloc[size]--;
 #endif
-
     Tcl_MutexUnlock(allocMutexPtr);
 }
 
@@ -510,34 +502,34 @@ TclpFree(
  */
 
 char *
-TclpRealloc(
-    char *oldPtr,		/* Pointer to alloced block. */
-    unsigned int numBytes)	/* New size of memory. */
-{
+TclpRealloc(cp, nbytes)
+    char *cp;			/* Pointer to alloced block. */
+    unsigned int nbytes;	/* New size of memory. */
+{   
     int i;
-    union overhead *overPtr;
+    union overhead *op;
     struct block *bigBlockPtr;
     int expensive;
-    unsigned long maxSize;
+    unsigned long maxsize;
 
-    if (oldPtr == NULL) {
-	return TclpAlloc(numBytes);
+    if (cp == NULL) {
+	return (TclpAlloc(nbytes));
     }
 
     Tcl_MutexLock(allocMutexPtr);
 
-    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
+    op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
 
-    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
-    ASSERT(overPtr->overMagic1 == MAGIC);
-    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
+    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) {
 	Tcl_MutexUnlock(allocMutexPtr);
 	return NULL;
     }
 
-    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
-    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
-    i = overPtr->bucketIndex;
+    RANGE_ASSERT(op->ov_rmagic == RMAGIC);
+    RANGE_ASSERT(*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) == RMAGIC);
+    i = op->ov_index;
 
     /*
      * If the block isn't in a bin, just realloc it.
@@ -545,11 +537,11 @@ TclpRealloc(
 
     if (i == 0xff) {
 	struct block *prevPtr, *nextPtr;
-	bigBlockPtr = (struct block *) overPtr - 1;
+	bigBlockPtr = (struct block *) op - 1;
 	prevPtr = bigBlockPtr->prevPtr;
 	nextPtr = bigBlockPtr->nextPtr;
-	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
-		sizeof(struct block) + OVERHEAD + numBytes);
+	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, 
+		sizeof(struct block) + OVERHEAD + nbytes);
 	if (bigBlockPtr == NULL) {
 	    Tcl_MutexUnlock(allocMutexPtr);
 	    return NULL;
@@ -557,69 +549,63 @@ TclpRealloc(
 
 	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;
 	}
 
-	overPtr = (union overhead *) (bigBlockPtr + 1);
-
+	op = (union overhead *) (bigBlockPtr + 1);
 #ifdef MSTATS
-	numMallocs[NBUCKETS]++;
+	nmalloc[NBUCKETS]++;
 #endif
-
 #ifndef NDEBUG
 	/*
 	 * Record allocated size of block and update magic number bounds.
 	 */
 
-	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-	BLOCK_END(overPtr) = RMAGIC;
+	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-
 	Tcl_MutexUnlock(allocMutexPtr);
-	return (char *)(overPtr+1);
+	return (char *)(op+1);
     }
-    maxSize = 1 << (i+3);
+    maxsize = 1 << (i+3);
     expensive = 0;
-    if (numBytes+OVERHEAD > maxSize) {
+    if ( nbytes + OVERHEAD > maxsize ) {
 	expensive = 1;
-    } else if (i>0 && numBytes+OVERHEAD < maxSize/2) {
+    } else if ( i > 0 && nbytes + OVERHEAD < (maxsize/2) ) {
 	expensive = 1;
     }
 
     if (expensive) {
-	void *newPtr;
+	void *newp;
 
 	Tcl_MutexUnlock(allocMutexPtr);
 
-	newPtr = TclpAlloc(numBytes);
-	if (newPtr == NULL) {
+	newp = TclpAlloc(nbytes);
+	if ( newp == NULL ) {
 	    return NULL;
 	}
-	maxSize -= OVERHEAD;
-	if (maxSize < numBytes) {
-	    numBytes = maxSize;
-	}
-	memcpy(newPtr, oldPtr, (size_t) numBytes);
-	TclpFree(oldPtr);
-	return newPtr;
+	maxsize -= OVERHEAD;
+	if ( maxsize < nbytes )
+	    nbytes = maxsize;
+	memcpy((VOID *) newp, (VOID *) cp, (size_t) nbytes);
+	TclpFree(cp);
+	return newp;
     }
-
+    
     /*
      * Ok, we don't have to copy, it fits as-is
      */
-
 #ifndef NDEBUG
-    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
-    BLOCK_END(overPtr) = RMAGIC;
+    op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
+    *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
-
     Tcl_MutexUnlock(allocMutexPtr);
-    return(oldPtr);
+    return(cp);
 }
 
 /*
@@ -627,9 +613,9 @@ TclpRealloc(
  *
  * 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.
@@ -642,39 +628,35 @@ TclpRealloc(
 
 #ifdef MSTATS
 void
-mstats(
-    char *s)			/* Where to write info. */
+mstats(s)
+    char *s;	/* Where to write info. */
 {
     register int i, j;
-    register union overhead *overPtr;
-    int totalFree = 0, totalUsed = 0;
+    register union overhead *p;
+    int totfree = 0,
+	totused = 0;
 
     Tcl_MutexLock(allocMutexPtr);
-
     fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
     for (i = 0; i < NBUCKETS; i++) {
-	for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
+	for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
 	    fprintf(stderr, " %d", j);
-	}
-	totalFree += j * (1 << (i + 3));
+	totfree += j * (1 << (i + 3));
     }
-
     fprintf(stderr, "\nused:\t");
     for (i = 0; i < NBUCKETS; i++) {
-	fprintf(stderr, " %d", numMallocs[i]);
-	totalUsed += numMallocs[i] * (1 << (i + 3));
+	fprintf(stderr, " %d", nmalloc[i]);
+	totused += nmalloc[i] * (1 << (i + 3));
     }
-
     fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
-	    totalUsed, totalFree);
-    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
-	    MAXMALLOC, numMallocs[NBUCKETS]);
-
+	    totused, totfree);
+    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", 
+	    MAXMALLOC, nmalloc[NBUCKETS]);
     Tcl_MutexUnlock(allocMutexPtr);
 }
 #endif
 
-#else	/* !USE_TCLALLOC */
+#else  /* !USE_TCLALLOC */
 
 /*
  *----------------------------------------------------------------------
@@ -693,10 +675,10 @@ mstats(
  */
 
 char *
-TclpAlloc(
-    unsigned int numBytes)	/* Number of bytes to allocate. */
+TclpAlloc(nbytes)
+    unsigned int nbytes;	/* Number of bytes to allocate. */
 {
-    return (char *) malloc(numBytes);
+    return (char*) malloc(nbytes);
 }
 
 /*
@@ -716,10 +698,10 @@ TclpAlloc(
  */
 
 void
-TclpFree(
-    char *oldPtr)		/* Pointer to memory to free. */
-{
-    free(oldPtr);
+TclpFree(cp)
+    char *cp;		/* Pointer to memory to free. */
+{   
+    free(cp);
     return;
 }
 
@@ -740,20 +722,12 @@ TclpFree(
  */
 
 char *
-TclpRealloc(
-    char *oldPtr,		/* Pointer to alloced block. */
-    unsigned int numBytes)	/* New size of memory. */
-{
-    return (char *) realloc(oldPtr, numBytes);
+TclpRealloc(cp, nbytes)
+    char *cp;			/* Pointer to alloced block. */
+    unsigned int nbytes;	/* New size of memory. */
+{   
+    return (char*) realloc(cp, nbytes);
 }
 
 #endif /* !USE_TCLALLOC */
 #endif /* !TCL_THREADS */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
deleted file mode 100644
index 02144a1..0000000
--- a/generic/tclAssembly.c
+++ /dev/null
@@ -1,4331 +0,0 @@
-/*
- * tclAssembly.c --
- *
- *	Assembler for Tcl bytecodes.
- *
- * This file contains the procedures that convert Tcl Assembly Language (TAL)
- * to a sequence of bytecode instructions for the Tcl execution engine.
- *
- * Copyright (c) 2010 by Ozgur Dogan Ugurlu.
- * Copyright (c) 2010 by Kevin B. Kenny.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-/*-
- *- THINGS TO DO:
- *- More instructions:
- *-   done - alternate exit point (affects stack and exception range checking)
- *-   break and continue - if exception ranges can be sorted out.
- *-   foreach_start4, foreach_step4
- *-   returnImm, returnStk
- *-   expandStart, expandStkTop, invokeExpanded
- *-   dictFirst, dictNext, dictDone
- *-   dictUpdateStart, dictUpdateEnd
- *-   jumpTable testing
- *-   syntax (?)
- *-   returnCodeBranch
- */
-
-#include "tclInt.h"
-#include "tclCompile.h"
-#include "tclOOInt.h"
-
-/*
- * Structure that represents a range of instructions in the bytecode.
- */
-
-typedef struct CodeRange {
-    int startOffset;		/* Start offset in the bytecode array */
-    int endOffset;		/* End offset in the bytecode array */
-} CodeRange;
-
-/*
- * State identified for a basic block's catch context.
- */
-
-typedef enum BasicBlockCatchState {
-    BBCS_UNKNOWN = 0,		/* Catch context has not yet been identified */
-    BBCS_NONE,			/* Block is outside of any catch */
-    BBCS_INCATCH,		/* Block is within a catch context */
-    BBCS_CAUGHT,		/* Block is within a catch context and
-				 * may be executed after an exception fires */
-} BasicBlockCatchState;
-
-/*
- * Structure that defines a basic block - a linear sequence of bytecode
- * instructions with no jumps in or out (including not changing the
- * state of any exception range).
- */
-
-typedef struct BasicBlock {
-    int originalStartOffset;	/* Instruction offset before JUMP1s were
-				 * substituted with JUMP4's */
-    int startOffset;		/* Instruction offset of the start of the
-				 * block */
-    int startLine;		/* Line number in the input script of the
-				 * instruction at the start of the block */
-    int jumpOffset;		/* Bytecode offset of the 'jump' instruction
-				 * that ends the block, or -1 if there is no
-				 * jump. */
-    int jumpLine;		/* Line number in the input script of the
-				 * 'jump' instruction that ends the block, or
-				 * -1 if there is no jump */
-    struct BasicBlock* prevPtr;	/* Immediate predecessor of this block */
-    struct BasicBlock* predecessor;
-				/* Predecessor of this block in the spanning
-				 * tree */
-    struct BasicBlock* successor1;
-				/* BasicBlock structure of the following
-				 * block: NULL at the end of the bytecode
-				 * sequence. */
-    Tcl_Obj* jumpTarget;	/* Jump target label if the jump target is
-				 * unresolved */
-    int initialStackDepth;	/* Absolute stack depth on entry */
-    int minStackDepth;		/* Low-water relative stack depth */
-    int maxStackDepth;		/* High-water relative stack depth */
-    int finalStackDepth;	/* Relative stack depth on exit */
-    enum BasicBlockCatchState catchState;
-				/* State of the block for 'catch' analysis */
-    int catchDepth;		/* Number of nested catches in which the basic
-				 * block appears */
-    struct BasicBlock* enclosingCatch;
-				/* BasicBlock structure of the last startCatch
-				 * executed on a path to this block, or NULL
-				 * if there is no enclosing catch */
-    int foreignExceptionBase;	/* Base index of foreign exceptions */
-    int foreignExceptionCount;	/* Count of foreign exceptions */
-    ExceptionRange* foreignExceptions;
-				/* ExceptionRange structures for exception
-				 * ranges belonging to embedded scripts and
-				 * expressions in this block */
-    JumptableInfo* jtPtr;	/* Jump table at the end of this basic block */
-    int flags;			/* Boolean flags */
-} BasicBlock;
-
-/*
- * Flags that pertain to a basic block.
- */
-
-enum BasicBlockFlags {
-    BB_VISITED = (1 << 0),	/* Block has been visited in the current
-				 * traversal */
-    BB_FALLTHRU = (1 << 1),	/* Control may pass from this block to a
-				 * successor */
-    BB_JUMP1 = (1 << 2),	/* Basic block ends with a 1-byte-offset jump
-				 * and may need expansion */
-    BB_JUMPTABLE = (1 << 3),	/* Basic block ends with a jump table */
-    BB_BEGINCATCH = (1 << 4),	/* Block ends with a 'beginCatch' instruction,
-				 * marking it as the start of a 'catch'
-				 * sequence. The 'jumpTarget' is the exception
-				 * exit from the catch block. */
-    BB_ENDCATCH = (1 << 5),	/* Block ends with an 'endCatch' instruction,
-				 * unwinding the catch from the exception
-				 * stack. */
-};
-
-/*
- * Source instruction type recognized by the assembler.
- */
-
-typedef enum TalInstType {
-    ASSEM_1BYTE,		/* Fixed arity, 1-byte instruction */
-    ASSEM_BEGIN_CATCH,		/* Begin catch: one 4-byte jump offset to be
-				 * converted to appropriate exception
-				 * ranges */
-    ASSEM_BOOL,			/* One Boolean operand */
-    ASSEM_BOOL_LVT4,		/* One Boolean, one 4-byte LVT ref. */
-    ASSEM_CONCAT1,		/* 1-byte unsigned-integer operand count, must
-				 * be strictly positive, consumes N, produces
-				 * 1 */
-    ASSEM_DICT_GET,		/* 'dict get' and related - consumes N+1
-				 * operands, produces 1, N > 0 */
-    ASSEM_DICT_SET,		/* specifies key count and LVT index, consumes
-				 * N+1 operands, produces 1, N > 0 */
-    ASSEM_DICT_UNSET,		/* specifies key count and LVT index, consumes
-				 * N operands, produces 1, N > 0 */
-    ASSEM_END_CATCH,		/* End catch. No args. Exception range popped
-				 * from stack and stack pointer restored. */
-    ASSEM_EVAL,			/* 'eval' - evaluate a constant script (by
-				 * compiling it in line with the assembly
-				 * code! I love Tcl!) */
-    ASSEM_INDEX,		/* 4 byte operand, integer or end-integer */
-    ASSEM_INVOKE,		/* 1- or 4-byte operand count, must be
-				 * strictly positive, consumes N, produces
-				 * 1. */
-    ASSEM_JUMP,			/* Jump instructions */
-    ASSEM_JUMP4,		/* Jump instructions forcing a 4-byte offset */
-    ASSEM_JUMPTABLE,		/* Jumptable (switch -exact) */
-    ASSEM_LABEL,		/* The assembly directive that defines a
-				 * label */
-    ASSEM_LINDEX_MULTI,		/* 4-byte operand count, must be strictly
-				 * positive, consumes N, produces 1 */
-    ASSEM_LIST,			/* 4-byte operand count, must be nonnegative,
-				 * consumses N, produces 1 */
-    ASSEM_LSET_FLAT,		/* 4-byte operand count, must be >= 3,
-				 * consumes N, produces 1 */
-    ASSEM_LVT,			/* One operand that references a local
-				 * variable */
-    ASSEM_LVT1,			/* One 1-byte operand that references a local
-				 * variable */
-    ASSEM_LVT1_SINT1,		/* One 1-byte operand that references a local
-				 * variable, one signed-integer 1-byte
-				 * operand */
-    ASSEM_LVT4,			/* One 4-byte operand that references a local
-				 * variable */
-    ASSEM_OVER,			/* OVER: 4-byte operand count, consumes N+1,
-				 * produces N+2 */
-    ASSEM_PUSH,			/* one literal operand */
-    ASSEM_REGEXP,		/* One Boolean operand, but weird mapping to
-				 * call flags */
-    ASSEM_REVERSE,		/* REVERSE: 4-byte operand count, consumes N,
-				 * produces N */
-    ASSEM_SINT1,		/* One 1-byte signed-integer operand
-				 * (INCR_STK_IMM) */
-    ASSEM_SINT4_LVT4,		/* Signed 4-byte integer operand followed by
-				 * LVT entry.  Fixed arity */
-} TalInstType;
-
-/*
- * Description of an instruction recognized by the assembler.
- */
-
-typedef struct TalInstDesc {
-    const char *name;		/* Name of instruction. */
-    TalInstType instType;	/* The type of instruction */
-    int tclInstCode;		/* Instruction code. For instructions having
-				 * 1- and 4-byte variables, tclInstCode is
-				 * ((1byte)<<8) || (4byte) */
-    int operandsConsumed;	/* Number of operands consumed by the
-				 * operation, or INT_MIN if the operation is
-				 * variadic */
-    int operandsProduced;	/* Number of operands produced by the
-				 * operation. If negative, the operation has a
-				 * net stack effect of -1-operandsProduced */
-} TalInstDesc;
-
-/*
- * Structure that holds the state of the assembler while generating code.
- */
-
-typedef struct AssemblyEnv {
-    CompileEnv* envPtr;		/* Compilation environment being used for code
-				 * generation */
-    Tcl_Parse* parsePtr;	/* Parse of the current line of source */
-    Tcl_HashTable labelHash;	/* Hash table whose keys are labels and whose
-				 * values are 'label' objects storing the code
-				 * offsets of the labels. */
-    int cmdLine;		/* Current line number within the assembly
-				 * code */
-    int* clNext;		/* Invisible continuation line for
-				 * [info frame] */
-    BasicBlock* head_bb;	/* First basic block in the code */
-    BasicBlock* curr_bb;	/* Current basic block */
-    int maxDepth;		/* Maximum stack depth encountered */
-    int curCatchDepth;		/* Current depth of catches */
-    int maxCatchDepth;		/* Maximum depth of catches encountered */
-    int flags;			/* Compilation flags (TCL_EVAL_DIRECT) */
-} AssemblyEnv;
-
-/*
- * Static functions defined in this file.
- */
-
-static void		AddBasicBlockRangeToErrorInfo(AssemblyEnv*,
-			    BasicBlock*);
-static BasicBlock *	AllocBB(AssemblyEnv*);
-static int		AssembleOneLine(AssemblyEnv* envPtr);
-static void		BBAdjustStackDepth(BasicBlock* bbPtr, int consumed,
-			    int produced);
-static void		BBUpdateStackReqs(BasicBlock* bbPtr, int tblIdx,
-			    int count);
-static void		BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx,
-			    int opnd, int count);
-static void		BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
-			    int opnd, int count);
-static void		BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
-			    int param, int count);
-static void		BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
-			    int count);
-static int		BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
-static int		CalculateJumpRelocations(AssemblyEnv*, int*);
-static int		CheckForUnclosedCatches(AssemblyEnv*);
-static int		CheckForThrowInWrongContext(AssemblyEnv*);
-static int		CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
-static int		BytecodeMightThrow(unsigned char);
-static int		CheckJumpTableLabels(AssemblyEnv*, BasicBlock*);
-static int		CheckNamespaceQualifiers(Tcl_Interp*, const char*,
-			    int);
-static int		CheckNonNegative(Tcl_Interp*, int);
-static int		CheckOneByte(Tcl_Interp*, int);
-static int		CheckSignedOneByte(Tcl_Interp*, int);
-static int		CheckStack(AssemblyEnv*);
-static int		CheckStrictlyPositive(Tcl_Interp*, int);
-static ByteCode *	CompileAssembleObj(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
-static void		CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
-			    TalInstDesc*);
-static int		DefineLabel(AssemblyEnv* envPtr, const char* label);
-static void		DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void		DupAssembleCodeInternalRep(Tcl_Obj* src,
-			    Tcl_Obj* dest);
-static void		FillInJumpOffsets(AssemblyEnv*);
-static int		CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
-			    Tcl_Obj* jumpTable);
-static int		FindLocalVar(AssemblyEnv* envPtr,
-			    Tcl_Token** tokenPtrPtr);
-static int		FinishAssembly(AssemblyEnv*);
-static void		FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
-static void		FreeAssemblyEnv(AssemblyEnv*);
-static int		GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
-static int		GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
-static int		GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*);
-static int		GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**);
-static void		LookForFreshCatches(BasicBlock*, BasicBlock**);
-static void		MoveCodeForJumps(AssemblyEnv*, int);
-static void		MoveExceptionRangesToBasicBlock(AssemblyEnv*, int,
-			    int);
-static AssemblyEnv*	NewAssemblyEnv(CompileEnv*, int);
-static int		ProcessCatches(AssemblyEnv*);
-static int		ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*,
-			    BasicBlock*, enum BasicBlockCatchState, int);
-static void		ResetVisitedBasicBlocks(AssemblyEnv*);
-static void		ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*);
-static void		ReportUndefinedLabel(AssemblyEnv*, BasicBlock*,
-			    Tcl_Obj*);
-static void		RestoreEmbeddedExceptionRanges(AssemblyEnv*);
-static int		StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
-			    BasicBlock *, int);
-static BasicBlock*	StartBasicBlock(AssemblyEnv*, int fallthrough,
-			    Tcl_Obj* jumpLabel);
-/* static int		AdvanceIp(const unsigned char *pc); */
-static int		StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
-			    BasicBlock *, int);
-static int		StackCheckExit(AssemblyEnv*);
-static void		StackFreshCatches(AssemblyEnv*, BasicBlock*, int,
-			    BasicBlock**, int*);
-static void		SyncStackDepth(AssemblyEnv*);
-static int		TclAssembleCode(CompileEnv* envPtr, const char* code,
-			    int codeLen, int flags);
-static void		UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
-			    BasicBlock**, int*);
-
-/*
- * Tcl_ObjType that describes bytecode emitted by the assembler.
- */
-
-static const Tcl_ObjType assembleCodeType = {
-    "assemblecode",
-    FreeAssembleCodeInternalRep, /* freeIntRepProc */
-    DupAssembleCodeInternalRep,	 /* dupIntRepProc */
-    NULL,			 /* updateStringProc */
-    NULL			 /* setFromAnyProc */
-};
-
-/*
- * 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.
- *
- * Macro to encapsulate the variable definition and setup.
- */
-
-#define DefineLineInformation \
-    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
-    int eclIndex = mapPtr->nuloc - 1
-
-#define SetLineInformation(word) \
-    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
-    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
-
-/*
- * Flags bits used by PushVarName.
- */
-
-#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
-
-/*
- * Source instructions recognized in the Tcl Assembly Language (TAL)
- */
-
-TalInstDesc TalInstructionTable[] = {
-    /* PUSH must be first, see the code near the end of TclAssembleCode */
-    {"push",		ASSEM_PUSH,	(INST_PUSH1<<8
-					 | INST_PUSH4),		0,	1},
-
-    {"add",		ASSEM_1BYTE,	INST_ADD,		2,	1},
-    {"append",		ASSEM_LVT,	(INST_APPEND_SCALAR1<<8
-					 | INST_APPEND_SCALAR4),1,	1},
-    {"appendArray",	ASSEM_LVT,	(INST_APPEND_ARRAY1<<8
-					 | INST_APPEND_ARRAY4),	2,	1},
-    {"appendArrayStk",	ASSEM_1BYTE,	INST_APPEND_ARRAY_STK,	3,	1},
-    {"appendStk",	ASSEM_1BYTE,	INST_APPEND_STK,	2,	1},
-    {"beginCatch",	ASSEM_BEGIN_CATCH,
-					INST_BEGIN_CATCH4,	0,	0},
-    {"bitand",		ASSEM_1BYTE,	INST_BITAND,		2,	1},
-    {"bitnot",		ASSEM_1BYTE,	INST_BITNOT,		1,	1},
-    {"bitor",		ASSEM_1BYTE,	INST_BITOR,		2,	1},
-    {"bitxor",		ASSEM_1BYTE,	INST_BITXOR,		2,	1},
-    {"concat",		ASSEM_CONCAT1,	INST_CONCAT1,		INT_MIN,1},
-    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
-    {"dictExpand",	ASSEM_1BYTE,	INST_DICT_EXPAND,	3,	1},
-    {"dictGet",		ASSEM_DICT_GET, INST_DICT_GET,		INT_MIN,1},
-    {"dictIncrImm",	ASSEM_SINT4_LVT4,
-					INST_DICT_INCR_IMM,	1,	1},
-    {"dictLappend",	ASSEM_LVT4,	INST_DICT_LAPPEND,	2,	1},
-    {"dictRecombineStk",ASSEM_1BYTE,	INST_DICT_RECOMBINE_STK,3,	0},
-    {"dictRecombineImm",ASSEM_LVT4,	INST_DICT_RECOMBINE_IMM,2,	0},
-    {"dictSet",		ASSEM_DICT_SET, INST_DICT_SET,		INT_MIN,1},
-    {"dictUnset",	ASSEM_DICT_UNSET,
-					INST_DICT_UNSET,	INT_MIN,1},
-    {"div",		ASSEM_1BYTE,	INST_DIV,		2,	1},
-    {"dup",		ASSEM_1BYTE,	INST_DUP,		1,	2},
-    {"endCatch",	ASSEM_END_CATCH,INST_END_CATCH,		0,	0},
-    {"eq",		ASSEM_1BYTE,	INST_EQ,		2,	1},
-    {"eval",		ASSEM_EVAL,	INST_EVAL_STK,		1,	1},
-    {"evalStk",		ASSEM_1BYTE,	INST_EVAL_STK,		1,	1},
-    {"exist",		ASSEM_LVT4,	INST_EXIST_SCALAR,	0,	1},
-    {"existArray",	ASSEM_LVT4,	INST_EXIST_ARRAY,	1,	1},
-    {"existArrayStk",	ASSEM_1BYTE,	INST_EXIST_ARRAY_STK,	2,	1},
-    {"existStk",	ASSEM_1BYTE,	INST_EXIST_STK,		1,	1},
-    {"expon",		ASSEM_1BYTE,	INST_EXPON,		2,	1},
-    {"expr",		ASSEM_EVAL,	INST_EXPR_STK,		1,	1},
-    {"exprStk",		ASSEM_1BYTE,	INST_EXPR_STK,		1,	1},
-    {"ge",		ASSEM_1BYTE,	INST_GE,		2,	1},
-    {"gt",		ASSEM_1BYTE,	INST_GT,		2,	1},
-    {"incr",		ASSEM_LVT1,	INST_INCR_SCALAR1,	1,	1},
-    {"incrArray",	ASSEM_LVT1,	INST_INCR_ARRAY1,	2,	1},
-    {"incrArrayImm",	ASSEM_LVT1_SINT1,
-					INST_INCR_ARRAY1_IMM,	1,	1},
-    {"incrArrayStk",	ASSEM_1BYTE,	INST_INCR_ARRAY_STK,	3,	1},
-    {"incrArrayStkImm", ASSEM_SINT1,	INST_INCR_ARRAY_STK_IMM,2,	1},
-    {"incrImm",		ASSEM_LVT1_SINT1,
-					INST_INCR_SCALAR1_IMM,	0,	1},
-    {"incrStk",		ASSEM_1BYTE,	INST_INCR_SCALAR_STK,	2,	1},
-    {"incrStkImm",	ASSEM_SINT1,	INST_INCR_SCALAR_STK_IMM,
-								1,	1},
-    {"invokeStk",	ASSEM_INVOKE,	(INST_INVOKE_STK1 << 8
-					 | INST_INVOKE_STK4),	INT_MIN,1},
-    {"jump",		ASSEM_JUMP,	INST_JUMP1,		0,	0},
-    {"jump4",		ASSEM_JUMP4,	INST_JUMP4,		0,	0},
-    {"jumpFalse",	ASSEM_JUMP,	INST_JUMP_FALSE1,	1,	0},
-    {"jumpFalse4",	ASSEM_JUMP4,	INST_JUMP_FALSE4,	1,	0},
-    {"jumpTable",	ASSEM_JUMPTABLE,INST_JUMP_TABLE,	1,	0},
-    {"jumpTrue",	ASSEM_JUMP,	INST_JUMP_TRUE1,	1,	0},
-    {"jumpTrue4",	ASSEM_JUMP4,	INST_JUMP_TRUE4,	1,	0},
-    {"label",		ASSEM_LABEL,	0,			0,	0},
-    {"land",		ASSEM_1BYTE,	INST_LAND,		2,	1},
-    {"lappend",		ASSEM_LVT,	(INST_LAPPEND_SCALAR1<<8
-					 | INST_LAPPEND_SCALAR4),
-								1,	1},
-    {"lappendArray",	ASSEM_LVT,	(INST_LAPPEND_ARRAY1<<8
-					 | INST_LAPPEND_ARRAY4),2,	1},
-    {"lappendArrayStk", ASSEM_1BYTE,	INST_LAPPEND_ARRAY_STK,	3,	1},
-    {"lappendStk",	ASSEM_1BYTE,	INST_LAPPEND_STK,	2,	1},
-    {"le",		ASSEM_1BYTE,	INST_LE,		2,	1},
-    {"lindexMulti",	ASSEM_LINDEX_MULTI,
-					INST_LIST_INDEX_MULTI,	INT_MIN,1},
-    {"list",		ASSEM_LIST,	INST_LIST,		INT_MIN,1},
-    {"listIn",		ASSEM_1BYTE,	INST_LIST_IN,		2,	1},
-    {"listIndex",	ASSEM_1BYTE,	INST_LIST_INDEX,	2,	1},
-    {"listIndexImm",	ASSEM_INDEX,	INST_LIST_INDEX_IMM,	1,	1},
-    {"listLength",	ASSEM_1BYTE,	INST_LIST_LENGTH,	1,	1},
-    {"listNotIn",	ASSEM_1BYTE,	INST_LIST_NOT_IN,	2,	1},
-    {"load",		ASSEM_LVT,	(INST_LOAD_SCALAR1 << 8
-					 | INST_LOAD_SCALAR4),	0,	1},
-    {"loadArray",	ASSEM_LVT,	(INST_LOAD_ARRAY1<<8
-					 | INST_LOAD_ARRAY4),	1,	1},
-    {"loadArrayStk",	ASSEM_1BYTE,	INST_LOAD_ARRAY_STK,	2,	1},
-    {"loadStk",		ASSEM_1BYTE,	INST_LOAD_SCALAR_STK,	1,	1},
-    {"lor",		ASSEM_1BYTE,	INST_LOR,		2,	1},
-    {"lsetFlat",	ASSEM_LSET_FLAT,INST_LSET_FLAT,		INT_MIN,1},
-    {"lsetList",	ASSEM_1BYTE,	INST_LSET_LIST,		3,	1},
-    {"lshift",		ASSEM_1BYTE,	INST_LSHIFT,		2,	1},
-    {"lt",		ASSEM_1BYTE,	INST_LT,		2,	1},
-    {"mod",		ASSEM_1BYTE,	INST_MOD,		2,	1},
-    {"mult",		ASSEM_1BYTE,	INST_MULT,		2,	1},
-    {"neq",		ASSEM_1BYTE,	INST_NEQ,		2,	1},
-    {"nop",		ASSEM_1BYTE,	INST_NOP,		0,	0},
-    {"not",		ASSEM_1BYTE,	INST_LNOT,		1,	1},
-    {"nsupvar",		ASSEM_LVT4,	INST_NSUPVAR,		2,	1},
-    {"over",		ASSEM_OVER,	INST_OVER,		INT_MIN,-1-1},
-    {"pop",		ASSEM_1BYTE,	INST_POP,		1,	0},
-    {"pushReturnCode",	ASSEM_1BYTE,	INST_PUSH_RETURN_CODE,	0,	1},
-    {"pushReturnOpts",	ASSEM_1BYTE,	INST_PUSH_RETURN_OPTIONS,
-								0,	1},
-    {"pushResult",	ASSEM_1BYTE,	INST_PUSH_RESULT,	0,	1},
-    {"regexp",		ASSEM_REGEXP,	INST_REGEXP,		2,	1},
-    {"reverse",		ASSEM_REVERSE,	INST_REVERSE,		INT_MIN,-1-0},
-    {"rshift",		ASSEM_1BYTE,	INST_RSHIFT,		2,	1},
-    {"store",		ASSEM_LVT,	(INST_STORE_SCALAR1<<8
-					 | INST_STORE_SCALAR4),	1,	1},
-    {"storeArray",	ASSEM_LVT,	(INST_STORE_ARRAY1<<8
-					 | INST_STORE_ARRAY4),	2,	1},
-    {"storeArrayStk",	ASSEM_1BYTE,	INST_STORE_ARRAY_STK,	3,	1},
-    {"storeStk",	ASSEM_1BYTE,	INST_STORE_SCALAR_STK,	2,	1},
-    {"strcmp",		ASSEM_1BYTE,	INST_STR_CMP,		2,	1},
-    {"streq",		ASSEM_1BYTE,	INST_STR_EQ,		2,	1},
-    {"strindex",	ASSEM_1BYTE,	INST_STR_INDEX,		2,	1},
-    {"strlen",		ASSEM_1BYTE,	INST_STR_LEN,		1,	1},
-    {"strmatch",	ASSEM_BOOL,	INST_STR_MATCH,		2,	1},
-    {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
-    {"sub",		ASSEM_1BYTE,	INST_SUB,		2,	1},
-    {"tryCvtToNumeric",	ASSEM_1BYTE,	INST_TRY_CVT_TO_NUMERIC,1,	1},
-    {"uminus",		ASSEM_1BYTE,	INST_UMINUS,		1,	1},
-    {"unset",		ASSEM_BOOL_LVT4,INST_UNSET_SCALAR,	0,	0},
-    {"unsetArray",	ASSEM_BOOL_LVT4,INST_UNSET_ARRAY,	1,	0},
-    {"unsetArrayStk",	ASSEM_BOOL,	INST_UNSET_ARRAY_STK,	2,	0},
-    {"unsetStk",	ASSEM_BOOL,	INST_UNSET_STK,		1,	0},
-    {"uplus",		ASSEM_1BYTE,	INST_UPLUS,		1,	1},
-    {"upvar",		ASSEM_LVT4,	INST_UPVAR,		2,	1},
-    {"variable",	ASSEM_LVT4,	INST_VARIABLE,		1,	0},
-    {NULL,		0,		0,			0,	0}
-};
-
-/*
- * List of instructions that cannot throw an exception under any
- * circumstances.  These instructions are the ones that are permissible after
- * an exception is caught but before the corresponding exception range is
- * popped from the stack.
- * The instructions must be in ascending order by numeric operation code.
- */
-
-static const unsigned char NonThrowingByteCodes[] = {
-    INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP,			/* 1-4 */
-    INST_JUMP1, INST_JUMP4,					/* 34-35 */
-    INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,	/* 70-72 */
-    INST_OVER,							/* 95 */
-    INST_PUSH_RETURN_OPTIONS,					/* 108 */
-    INST_REVERSE,						/* 126 */
-    INST_NOP							/* 132 */
-};
-
-/*
- * Helper macros.
- */
-
-#if defined(TCL_DEBUG_ASSEMBLY) && defined(__GNUC__) && __GNUC__ > 2
-#define DEBUG_PRINT(...)	fprintf(stderr, ##__VA_ARGS__);fflush(stderr)
-#elif defined(__GNUC__) && __GNUC__ > 2
-#define DEBUG_PRINT(...)	/* nothing */
-#else
-#define DEBUG_PRINT		/* nothing */
-#endif
-
-/*
- *-----------------------------------------------------------------------------
- *
- * BBAdjustStackDepth --
- *
- *	When an opcode is emitted, adjusts the stack information in the basic
- *	block to reflect the number of operands produced and consumed.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Updates minimum, maximum and final stack requirements in the basic
- *	block.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-BBAdjustStackDepth(
-    BasicBlock *bbPtr,		/* Structure describing the basic block */
-    int consumed,		/* Count of operands consumed by the
-				 * operation */
-    int produced)		/* Count of operands produced by the
-				 * operation */
-{
-    int depth = bbPtr->finalStackDepth;
-
-    depth -= consumed;
-    if (depth < bbPtr->minStackDepth) {
-	bbPtr->minStackDepth = depth;
-    }
-    depth += produced;
-    if (depth > bbPtr->maxStackDepth) {
-	bbPtr->maxStackDepth = depth;
-    }
-    bbPtr->finalStackDepth = depth;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * BBUpdateStackReqs --
- *
- *	Updates the stack requirements of a basic block, given the opcode
- *	being emitted and an operand count.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Updates min, max and final stack requirements in the basic block.
- *
- * Notes:
- *	This function must not be called for instructions such as REVERSE and
- *	OVER that are variadic but do not consume all their operands. Instead,
- *	BBAdjustStackDepth should be called directly.
- *
- *	count should be provided only for variadic operations. For operations
- *	with known arity, count should be 0.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-BBUpdateStackReqs(
-    BasicBlock* bbPtr,		/* Structure describing the basic block */
-    int tblIdx,			/* Index in TalInstructionTable of the
-				 * operation being assembled */
-    int count)			/* Count of operands for variadic insts */
-{
-    int consumed = TalInstructionTable[tblIdx].operandsConsumed;
-    int produced = TalInstructionTable[tblIdx].operandsProduced;
-
-    if (consumed == INT_MIN) {
-	/*
-	 * The instruction is variadic; it consumes 'count' operands.
-	 */
-
-	consumed = count;
-    }
-    if (produced < 0) {
-	/*
-	 * The instruction leaves some of its variadic operands on the stack,
-	 * with net stack effect of '-1-produced'
-	 */
-
-	produced = consumed - produced - 1;
-    }
-    BBAdjustStackDepth(bbPtr, consumed, produced);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * BBEmitOpcode, BBEmitInstInt1, BBEmitInstInt4 --
- *
- *	Emit the opcode part of an instruction, or the entirety of an
- *	instruction with a 1- or 4-byte operand, and adjust stack
- *	requirements.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Stores instruction and operand in the operand stream, and adjusts the
- *	stack.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-BBEmitOpcode(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int tblIdx,			/* Table index in TalInstructionTable of op */
-    int count)			/* Operand count for variadic ops */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
-				/* Current basic block */
-    int op = TalInstructionTable[tblIdx].tclInstCode & 0xff;
-
-    /*
-     * If this is the first instruction in a basic block, record its line
-     * number.
-     */
-
-    if (bbPtr->startOffset == envPtr->codeNext - envPtr->codeStart) {
-	bbPtr->startLine = assemEnvPtr->cmdLine;
-    }
-
-    TclEmitInt1(op, envPtr);
-    envPtr->atCmdStart = ((op) == INST_START_CMD);
-    BBUpdateStackReqs(bbPtr, tblIdx, count);
-}
-
-static void
-BBEmitInstInt1(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int tblIdx,			/* Index in TalInstructionTable of op */
-    int opnd,			/* 1-byte operand */
-    int count)			/* Operand count for variadic ops */
-{
-    BBEmitOpcode(assemEnvPtr, tblIdx, count);
-    TclEmitInt1(opnd, assemEnvPtr->envPtr);
-}
-
-static void
-BBEmitInstInt4(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int tblIdx,			/* Index in TalInstructionTable of op */
-    int opnd,			/* 4-byte operand */
-    int count)			/* Operand count for variadic ops */
-{
-    BBEmitOpcode(assemEnvPtr, tblIdx, count);
-    TclEmitInt4(opnd, assemEnvPtr->envPtr);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * BBEmitInst1or4 --
- *
- *	Emits a 1- or 4-byte operation according to the magnitude of the
- *	operand
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-BBEmitInst1or4(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int tblIdx,			/* Index in TalInstructionTable of op */
-    int param,			/* Variable-length parameter */
-    int count)			/* Arity if variadic */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
-				/* Current basic block */
-    int op = TalInstructionTable[tblIdx].tclInstCode;
-
-    if (param <= 0xff) {
-	op >>= 8;
-    } else {
-	op &= 0xff;
-    }
-    TclEmitInt1(op, envPtr);
-    if (param <= 0xff) {
-	TclEmitInt1(param, envPtr);
-    } else {
-	TclEmitInt4(param, envPtr);
-    }
-    envPtr->atCmdStart = ((op) == INST_START_CMD);
-    BBUpdateStackReqs(bbPtr, tblIdx, count);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * Tcl_AssembleObjCmd, TclNRAssembleObjCmd --
- *
- *	Direct evaluation path for tcl::unsupported::assemble
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	Assembles the code in objv[1], and executes it, so side effects
- *	include whatever the code does.
- *
- *-----------------------------------------------------------------------------
- */
-
-int
-Tcl_AssembleObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    /*
-     * Boilerplate - make sure that there is an NRE trampoline on the C stack
-     * because there needs to be one in place to execute bytecode.
-     */
-
-    return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRAssembleObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    ByteCode *codePtr;		/* Pointer to the bytecode to execute */
-    Tcl_Obj* backtrace;		/* Object where extra error information is
-				 * constructed. */
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Assemble the source to bytecode.
-     */
-
-    codePtr = CompileAssembleObj(interp, objv[1]);
-
-    /*
-     * On failure, report error line.
-     */
-
-    if (codePtr == NULL) {
-	Tcl_AddErrorInfo(interp, "\n    (\"");
-	Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0]));
-	Tcl_AddErrorInfo(interp, "\" body, line ");
-	backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
-	Tcl_IncrRefCount(backtrace);
-	Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace));
-	Tcl_DecrRefCount(backtrace);
-	Tcl_AddErrorInfo(interp, ")");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Use NRE to evaluate the bytecode from the trampoline.
-     */
-
-    return TclNRExecuteByteCode(interp, codePtr);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CompileAssembleObj --
- *
- *	Sets up and assembles Tcl bytecode for the direct-execution path in
- *	the Tcl bytecode assembler.
- *
- * Results:
- *	Returns a pointer to the assembled code. Returns NULL if the assembly
- *	fails for any reason, with an appropriate error message in the
- *	interpreter.
- *
- *-----------------------------------------------------------------------------
- */
-
-static ByteCode *
-CompileAssembleObj(
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    Tcl_Obj *objPtr)		/* Source code to assemble */
-{
-    Interp *iPtr = (Interp *) interp;
-				/* Internals of the interpreter */
-    CompileEnv compEnv;		/* Compilation environment structure */
-    register ByteCode *codePtr = NULL;
-				/* Bytecode resulting from the assembly */
-    register const AuxData * auxDataPtr;
-				/* Pointer to an auxiliary data element
-				 * in a compilation environment being
-				 * destroyed. */
-    Namespace* namespacePtr;	/* Namespace in which variable and command
-				 * names in the bytecode resolve */
-    int status;			/* Status return from Tcl_AssembleCode */
-    const char* source;		/* String representation of the source code */
-    int sourceLen;		/* Length of the source code in bytes */
-    int i;
-
-
-    /*
-     * Get the expression ByteCode from the object. If it exists, make sure it
-     * is valid in the current context.
-     */
-
-    if (objPtr->typePtr == &assembleCodeType) {
-	namespacePtr = iPtr->varFramePtr->nsPtr;
-	codePtr = objPtr->internalRep.otherValuePtr;
-	if (((Interp *) *codePtr->interpHandle == iPtr)
-		&& (codePtr->compileEpoch == iPtr->compileEpoch)
-		&& (codePtr->nsPtr == namespacePtr)
-		&& (codePtr->nsEpoch == namespacePtr->resolverEpoch)
-		&& (codePtr->localCachePtr
-			== iPtr->varFramePtr->localCachePtr)) {
-	    return codePtr;
-	}
-
-	/*
-	 * Not valid, so free it and regenerate.
-	 */
-
-	FreeAssembleCodeInternalRep(objPtr);
-    }
-
-    /*
-     * Set up the compilation environment, and assemble the code.
-     */
-
-    source = TclGetStringFromObj(objPtr, &sourceLen);
-    TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
-    status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
-    if (status != TCL_OK) {
-	/*
-	 * Assembly failed. Clean up and report the error.
-	 */
-
-	/*
-	 * Free any literals that were constructed for the assembly.
-	 */
-	for (i = 0; i < compEnv.literalArrayNext; i++) {
-	    TclReleaseLiteral(interp, compEnv.literalArrayPtr[i].objPtr);
-	}
-
-	/*
-	 * Free any auxiliary data that was attached to the bytecode
-	 * under construction.
-	 */
-
-	for (i = 0; i < compEnv.auxDataArrayNext; i++) {
-	    auxDataPtr = compEnv.auxDataArrayPtr + i;
-	    if (auxDataPtr->type->freeProc != NULL) {
-		(auxDataPtr->type->freeProc)(auxDataPtr->clientData);
-	    }
-	}
-
-	/*
-	 * TIP 280. If there is extended command line information,
-	 * we need to clean it up.
-	 */
-
-	if (compEnv.extCmdMapPtr != NULL) {
-	    if (compEnv.extCmdMapPtr->type == TCL_LOCATION_SOURCE) {
-		Tcl_DecrRefCount(compEnv.extCmdMapPtr->path);
-	    }
-	    for (i = 0; i < compEnv.extCmdMapPtr->nuloc; ++i) {
-		ckfree(compEnv.extCmdMapPtr->loc[i].line);
-	    }
-	    if (compEnv.extCmdMapPtr->loc != NULL) {
-		ckfree(compEnv.extCmdMapPtr->loc);
-	    }
-	    Tcl_DeleteHashTable(&(compEnv.extCmdMapPtr->litInfo));
-	}
-
-	TclFreeCompileEnv(&compEnv);
-	return NULL;
-    }
-
-    /*
-     * 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.
-     */
-
-    TclEmitOpcode(INST_DONE, &compEnv);
-    TclInitByteCodeObj(objPtr, &compEnv);
-    objPtr->typePtr = &assembleCodeType;
-    TclFreeCompileEnv(&compEnv);
-
-    /*
-     * Record the local variable context to which the bytecode pertains
-     */
-
-    codePtr = objPtr->internalRep.otherValuePtr;
-    if (iPtr->varFramePtr->localCachePtr) {
-	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
-	codePtr->localCachePtr->refCount++;
-    }
-
-    /*
-     * Report on what the assembler did.
-     */
-
-#ifdef TCL_COMPILE_DEBUG
-    if (tclTraceCompile >= 2) {
-	TclPrintByteCodeObj(interp, objPtr);
-	fflush(stdout);
-    }
-#endif /* TCL_COMPILE_DEBUG */
-
-    return codePtr;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * TclCompileAssembleCmd --
- *
- *	Compilation procedure for the '::tcl::unsupported::assemble' command.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	Puts the result of assembling the code into the bytecode stream in
- *	'compileEnv'.
- *
- * This procedure makes sure that the command has a single arg, which is
- * constant. If that condition is met, the procedure calls TclAssembleCode to
- * produce bytecode for the given assembly code, and returns any error
- * resulting from the assembly.
- *
- *-----------------------------------------------------------------------------
- */
-
-int
-TclCompileAssembleCmd(
-    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;	/* Token in the input script */
-
-    /*
-     * Make sure that the command has a single arg that is a simple word.
-     */
-
-    if (parsePtr->numWords != 2) {
-	return TCL_ERROR;
-    }
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Compile the code and return any error from the compilation.
-     */
-
-    return TclAssembleCode(envPtr, tokenPtr[1].start, tokenPtr[1].size, 0);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * TclAssembleCode --
- *
- *	Take a list of instructions in a Tcl_Obj, and assemble them to Tcl
- *	bytecodes
- *
- * Results:
- *	Returns TCL_OK on success, TCL_ERROR on failure.  If 'flags' includes
- *	TCL_EVAL_DIRECT, places an error message in the interpreter result.
- *
- * Side effects:
- *	Adds byte codes to the compile environment, and updates the
- *	environment's stack depth.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-TclAssembleCode(
-    CompileEnv *envPtr,		/* Compilation environment that is to receive
-				 * the generated bytecode */
-    const char* codePtr,	/* Assembly-language code to be processed */
-    int codeLen,		/* Length of the code */
-    int flags)			/* OR'ed combination of flags */
-{
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    /*
-     * Walk through the assembly script using the Tcl parser.  Each 'command'
-     * will be an instruction or assembly directive.
-     */
-
-    const char* instPtr = codePtr;
-				/* Where to start looking for a line of code */
-    int instLen;		/* Length in bytes of the current line of
-				 * code */
-    const char* nextPtr;	/* Pointer to the end of the line of code */
-    int bytesLeft = codeLen;	/* Number of bytes of source code remaining to
-				 * be parsed */
-    int status;			/* Tcl status return */
-    AssemblyEnv* assemEnvPtr = NewAssemblyEnv(envPtr, flags);
-    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
-
-    do {
-	/*
-	 * Parse out one command line from the assembly script.
-	 */
-
-	status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
-	instLen = parsePtr->commandSize;
-	if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
-	    --instLen;
-	}
-
-	/*
-	 * Report errors in the parse.
-	 */
-
-	if (status != TCL_OK) {
-	    if (flags & TCL_EVAL_DIRECT) {
-		Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
-			instLen);
-	    }
-	    FreeAssemblyEnv(assemEnvPtr);
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Advance the pointers around any leading commentary.
-	 */
-
-	TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr,
-		parsePtr->commandStart);
-	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
-		parsePtr->commandStart - envPtr->source);
-
-	/*
-	 * Process the line of code.
-	 */
-
-	if (parsePtr->numWords > 0) {
-	    /*
-	     * If tracing, show each line assembled as it happens.
-	     */
-
-#ifdef TCL_COMPILE_DEBUG
-	    if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) {
-		printf("  %4ld Assembling: ",
-			(long)(envPtr->codeNext - envPtr->codeStart));
-		TclPrintSource(stdout, parsePtr->commandStart,
-			TclMin(instLen, 55));
-		printf("\n");
-	    }
-#endif
-	    if (AssembleOneLine(assemEnvPtr) != TCL_OK) {
-		if (flags & TCL_EVAL_DIRECT) {
-		    Tcl_LogCommandInfo(interp, codePtr,
-			    parsePtr->commandStart, instLen);
-		}
-		Tcl_FreeParse(parsePtr);
-		FreeAssemblyEnv(assemEnvPtr);
-		return TCL_ERROR;
-	    }
-	}
-
-	/*
-	 * Advance to the next line of code.
-	 */
-
-	nextPtr = parsePtr->commandStart + parsePtr->commandSize;
-	bytesLeft -= (nextPtr - instPtr);
-	instPtr = nextPtr;
-	TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart,
-		instPtr);
-	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
-		instPtr - envPtr->source);
-	Tcl_FreeParse(parsePtr);
-    } while (bytesLeft > 0);
-
-    /*
-     * Done with parsing the code.
-     */
-
-    status = FinishAssembly(assemEnvPtr);
-    FreeAssemblyEnv(assemEnvPtr);
-    return status;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * NewAssemblyEnv --
- *
- *	Creates an environment for the assembler to run in.
- *
- * Results:
- *	Allocates, initialises and returns an assembler environment
- *
- *-----------------------------------------------------------------------------
- */
-
-static AssemblyEnv*
-NewAssemblyEnv(
-    CompileEnv* envPtr,		/* Compilation environment being used for code
-				 * generation*/
-    int flags)			/* Compilation flags (TCL_EVAL_DIRECT) */
-{
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv));
-				/* Assembler environment under construction */
-    Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
-				/* Parse of one line of assembly code */
-
-    assemEnvPtr->envPtr = envPtr;
-    assemEnvPtr->parsePtr = parsePtr;
-    assemEnvPtr->cmdLine = envPtr->line;
-    assemEnvPtr->clNext = envPtr->clNext;
-
-    /*
-     * Make the hashtables that store symbol resolution.
-     */
-
-    Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS);
-
-    /*
-     * Start the first basic block.
-     */
-
-    assemEnvPtr->curr_bb = NULL;
-    assemEnvPtr->head_bb = AllocBB(assemEnvPtr);
-    assemEnvPtr->curr_bb = assemEnvPtr->head_bb;
-    assemEnvPtr->head_bb->startLine = 1;
-
-    /*
-     * Stash compilation flags.
-     */
-
-    assemEnvPtr->flags = flags;
-    return assemEnvPtr;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * FreeAssemblyEnv --
- *
- *	Cleans up the assembler environment when assembly is complete.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-FreeAssemblyEnv(
-    AssemblyEnv* assemEnvPtr)	/* Environment to free */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment being used for code
-				 * generation */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    BasicBlock* thisBB;		/* Pointer to a basic block being deleted */
-    BasicBlock* nextBB;		/* Pointer to a deleted basic block's
-				 * successor */
-
-    /*
-     * Free all the basic block structures.
-     */
-
-    for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
-	if (thisBB->jumpTarget != NULL) {
-	    Tcl_DecrRefCount(thisBB->jumpTarget);
-	}
-	if (thisBB->foreignExceptions != NULL) {
-	    ckfree(thisBB->foreignExceptions);
-	}
-	nextBB = thisBB->successor1;
-	if (thisBB->jtPtr != NULL) {
-	    DeleteMirrorJumpTable(thisBB->jtPtr);
-	    thisBB->jtPtr = NULL;
-	}
-	ckfree(thisBB);
-    }
-
-    /*
-     * Dispose what's left.
-     */
-
-    Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
-    TclStackFree(interp, assemEnvPtr->parsePtr);
-    TclStackFree(interp, assemEnvPtr);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * AssembleOneLine --
- *
- *	Assembles a single command from an assembly language source.
- *
- * Results:
- *	Returns TCL_ERROR with an appropriate error message if the assembly
- *	fails. Returns TCL_OK if the assembly succeeds. Updates the assembly
- *	environment with the state of the assembly.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-AssembleOneLine(
-    AssemblyEnv* assemEnvPtr)	/* State of the assembly */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment being used for code
-				 * gen */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
-				/* Parse of the line of code */
-    Tcl_Token* tokenPtr;	/* Current token within the line of code */
-    Tcl_Obj* instNameObj;	/* Name of the instruction */
-    int tblIdx;			/* Index in TalInstructionTable of the
-				 * instruction */
-    enum TalInstType instType;	/* Type of the instruction */
-    Tcl_Obj* operand1Obj = NULL;
-				/* First operand to the instruction */
-    const char* operand1;	/* String rep of the operand */
-    int operand1Len;		/* String length of the operand */
-    int opnd;			/* Integer representation of an operand */
-    int litIndex;		/* Literal pool index of a constant */
-    int localVar;		/* LVT index of a local variable */
-    int flags;			/* Flags for a basic block */
-    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
-    int infoIndex;		/* Index of the jumptable in auxdata */
-    int status = TCL_ERROR;	/* Return value from this function */
-
-    /*
-     * Make sure that the instruction name is known at compile time.
-     */
-
-    tokenPtr = parsePtr->tokenPtr;
-    if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Look up the instruction name.
-     */
-
-    if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
-	    &TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
-	    TCL_EXACT, &tblIdx) != TCL_OK) {
-	goto cleanup;
-    }
-
-    /*
-     * Vector on the type of instruction being processed.
-     */
-
-    instType = TalInstructionTable[tblIdx].instType;
-    switch (instType) {
-
-    case ASSEM_PUSH:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
-	    goto cleanup;
-	}
-	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
-	    goto cleanup;
-	}
-	operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
-	litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
-	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
-	break;
-
-    case ASSEM_1BYTE:
-	if (parsePtr->numWords != 1) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
-	    goto cleanup;
-	}
-	BBEmitOpcode(assemEnvPtr, tblIdx, 0);
-	break;
-
-    case ASSEM_BEGIN_CATCH:
-	/*
-	 * Emit the BEGIN_CATCH instruction with the code offset of the
-	 * exception branch target instead of the exception range index. The
-	 * correct index will be generated and inserted later, when catches
-	 * are being resolved.
-	 */
-
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
-	    goto cleanup;
-	}
-	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
-	    goto cleanup;
-	}
-	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
-	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
-	BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
-	assemEnvPtr->curr_bb->flags |= BB_BEGINCATCH;
-	StartBasicBlock(assemEnvPtr, BB_FALLTHRU, operand1Obj);
-	break;
-
-    case ASSEM_BOOL:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
-	    goto cleanup;
-	}
-	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
-	break;
-
-    case ASSEM_BOOL_LVT4:
-	if (parsePtr->numWords != 3) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
-	    goto cleanup;
-	}
-	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0) {
-	    goto cleanup;
-	}
-	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
-	TclEmitInt4(localVar, envPtr);
-	break;
-
-    case ASSEM_CONCAT1:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckOneByte(interp, opnd) != TCL_OK
-		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
-	break;
-
-    case ASSEM_DICT_GET:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
-	break;
-
-    case ASSEM_DICT_SET:
-	if (parsePtr->numWords != 3) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
-	TclEmitInt4(localVar, envPtr);
-	break;
-
-    case ASSEM_DICT_UNSET:
-	if (parsePtr->numWords != 3) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
-	TclEmitInt4(localVar, envPtr);
-	break;
-
-    case ASSEM_END_CATCH:
-	if (parsePtr->numWords != 1) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
-	    goto cleanup;
-	}
-	assemEnvPtr->curr_bb->flags |= BB_ENDCATCH;
-	BBEmitOpcode(assemEnvPtr, tblIdx, 0);
-	StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
-	break;
-
-    case ASSEM_EVAL:
-	/* TODO - Refactor this stuff into a subroutine that takes the inst
-	 * code, the message ("script" or "expression") and an evaluator
-	 * callback that calls TclCompileScript or TclCompileExpr. */
-
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj,
-		    ((TalInstructionTable[tblIdx].tclInstCode
-		    == INST_EVAL_STK) ? "script" : "expression"));
-	    goto cleanup;
-	}
-	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
-		    TalInstructionTable+tblIdx);
-	} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
-		&operand1Obj) != TCL_OK) {
-	    goto cleanup;
-	} else {
-	    operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
-	    litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
-
-	    /*
-	     * Assumes that PUSH is the first slot!
-	     */
-
-	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
-	    BBEmitOpcode(assemEnvPtr, tblIdx, 0);
-	}
-	break;
-
-    case ASSEM_INVOKE:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-
-	BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
-	break;
-
-    case ASSEM_JUMP:
-    case ASSEM_JUMP4:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
-	    goto cleanup;
-	}
-	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
-	    goto cleanup;
-	}
-	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
-	if (instType == ASSEM_JUMP) {
-	    flags = BB_JUMP1;
-	    BBEmitInstInt1(assemEnvPtr, tblIdx, 0, 0);
-	} else {
-	    flags = 0;
-	    BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
-	}
-
-	/*
-	 * Start a new basic block at the instruction following the jump.
-	 */
-
-	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
-	if (TalInstructionTable[tblIdx].operandsConsumed != 0) {
-	    flags |= BB_FALLTHRU;
-	}
-	StartBasicBlock(assemEnvPtr, flags, operand1Obj);
-	break;
-
-    case ASSEM_JUMPTABLE:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
-	    goto cleanup;
-	}
-	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
-	    goto cleanup;
-	}
-
-	jtPtr = ckalloc(sizeof(JumptableInfo));
-
-	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
-	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
-	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
-	DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n",
-		assemEnvPtr->curr_bb, assemEnvPtr->cmdLine,
-		envPtr->codeNext - envPtr->codeStart);
-
-	infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
-	DEBUG_PRINT("auxdata index=%d\n", infoIndex);
-
-	BBEmitInstInt4(assemEnvPtr, tblIdx, infoIndex, 0);
-	if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) {
-	    goto cleanup;
-	}
-	StartBasicBlock(assemEnvPtr, BB_JUMPTABLE|BB_FALLTHRU, NULL);
-	break;
-
-    case ASSEM_LABEL:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "name");
-	    goto cleanup;
-	}
-	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
-	    goto cleanup;
-	}
-
-	/*
-	 * Add the (label_name, address) pair to the hash table.
-	 */
-
-	if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
-	    goto cleanup;
-	}
-	break;
-
-    case ASSEM_LINDEX_MULTI:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
-	break;
-
-    case ASSEM_LIST:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckNonNegative(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
-	break;
-
-    case ASSEM_INDEX:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
-	break;
-
-    case ASSEM_LSET_FLAT:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	if (opnd < 2) {
-	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-		Tcl_SetObjResult(interp,
-			Tcl_NewStringObj("operand must be >=2", -1));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
-	    }
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
-	break;
-
-    case ASSEM_LVT:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0) {
-	    goto cleanup;
-	}
-	BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
-	break;
-
-    case ASSEM_LVT1:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0 || CheckOneByte(interp, localVar)) {
-	    goto cleanup;
-	}
-	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
-	break;
-
-    case ASSEM_LVT1_SINT1:
-	if (parsePtr->numWords != 3) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0 || CheckOneByte(interp, localVar)
-		|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckSignedOneByte(interp, opnd)) {
-	    goto cleanup;
-	}
-	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
-	TclEmitInt1(opnd, envPtr);
-	break;
-
-    case ASSEM_LVT4:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
-	break;
-
-    case ASSEM_OVER:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckNonNegative(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
-	break;
-
-    case ASSEM_REGEXP:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
-	    goto cleanup;
-	}
-	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	{
-	    int flags = TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0);
-
-	    BBEmitInstInt1(assemEnvPtr, tblIdx, flags, 0);
-	}
-	break;
-
-    case ASSEM_REVERSE:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckNonNegative(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
-	break;
-
-    case ASSEM_SINT1:
-	if (parsePtr->numWords != 2) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
-		|| CheckSignedOneByte(interp, opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
-	break;
-
-    case ASSEM_SINT4_LVT4:
-	if (parsePtr->numWords != 3) {
-	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
-	    goto cleanup;
-	}
-	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
-	    goto cleanup;
-	}
-	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
-	if (localVar < 0) {
-	    goto cleanup;
-	}
-	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
-	TclEmitInt4(localVar, envPtr);
-	break;
-
-    default:
-	Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
-		Tcl_GetString(instNameObj));
-    }
-
-    status = TCL_OK;
- cleanup:
-    Tcl_DecrRefCount(instNameObj);
-    if (operand1Obj) {
-	Tcl_DecrRefCount(operand1Obj);
-    }
-    return status;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CompileEmbeddedScript --
- *
- *	Compile an embedded 'eval' or 'expr' that appears in assembly code.
- *
- * This procedure is called when the 'eval' or 'expr' assembly directive is
- * encountered, and the argument to the directive is a simple word that
- * requires no substitution. The appropriate compiler (TclCompileScript or
- * TclCompileExpr) is invoked recursively, and emits bytecode.
- *
- * Before the compiler is invoked, the compilation environment's stack
- * consumption is reset to zero. Upon return from the compilation, the net
- * stack effect of the compilation is in the compiler env, and this stack
- * effect is posted to the assembler environment. The compile environment's
- * stack consumption is then restored to what it was before (which is actually
- * the state of the stack on entry to the block of assembly code).
- *
- * Any exception ranges pushed by the compilation are copied to the basic
- * block and removed from the compiler environment. They will be rebuilt at
- * the end of assembly, when the exception stack depth is actually known.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-CompileEmbeddedScript(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    Tcl_Token* tokenPtr,	/* Tcl_Token containing the script */
-    TalInstDesc* instPtr)	/* Instruction that determines whether
-				 * the script is 'expr' or 'eval' */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-
-    /*
-     * The expression or script is not only known at compile time, but
-     * actually a "simple word". It can be compiled inline by invoking the
-     * compiler recursively.
-     *
-     * Save away the stack depth and reset it before compiling the script.
-     * We'll record the stack usage of the script in the BasicBlock, and
-     * accumulate it together with the stack usage of the enclosing assembly
-     * code.
-     */
-
-    int savedStackDepth = envPtr->currStackDepth;
-    int savedMaxStackDepth = envPtr->maxStackDepth;
-    int savedCodeIndex = envPtr->codeNext - envPtr->codeStart;
-    int savedExceptArrayNext = envPtr->exceptArrayNext;
-
-    envPtr->currStackDepth = 0;
-    envPtr->maxStackDepth = 0;
-
-    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
-    switch(instPtr->tclInstCode) {
-    case INST_EVAL_STK:
-	TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
-	break;
-    case INST_EXPR_STK:
-	TclCompileExpr(interp, tokenPtr->start, tokenPtr->size, envPtr, 1);
-	break;
-    default:
-	Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen",
-		instPtr->name, instPtr->tclInstCode);
-    }
-
-    /*
-     * Roll up the stack usage of the embedded block into the assembler
-     * environment.
-     */
-
-    SyncStackDepth(assemEnvPtr);
-    envPtr->currStackDepth = savedStackDepth;
-    envPtr->maxStackDepth = savedMaxStackDepth;
-
-    /*
-     * Save any exception ranges that were pushed by the compiler; they will
-     * need to be fixed up once the stack depth is known.
-     */
-
-    MoveExceptionRangesToBasicBlock(assemEnvPtr, savedCodeIndex,
-	    savedExceptArrayNext);
-
-    /*
-     * Flush the current basic block.
-     */
-
-    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * SyncStackDepth --
- *
- *	Copies the stack depth from the compile environment to a basic block.
- *
- * Side effects:
- *	Current and max stack depth in the current basic block are adjusted.
- *
- * This procedure is called on return from invoking the compiler for the
- * 'eval' and 'expr' operations. It adjusts the stack depth of the current
- * basic block to reflect the stack required by the just-compiled code.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-SyncStackDepth(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
-				/* Current basic block */
-    int maxStackDepth = curr_bb->finalStackDepth + envPtr->maxStackDepth;
-				/* Max stack depth in the basic block */
-
-    if (maxStackDepth > curr_bb->maxStackDepth) {
-	curr_bb->maxStackDepth = maxStackDepth;
-    }
-    curr_bb->finalStackDepth += envPtr->currStackDepth;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * MoveExceptionRangesToBasicBlock --
- *
- *	Removes exception ranges that were created by compiling an embedded
- *	script from the CompileEnv, and stores them in the BasicBlock. They
- *	will be reinstalled, at the correct stack depth, after control flow
- *	analysis is complete on the assembly code.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-MoveExceptionRangesToBasicBlock(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int savedCodeIndex,		/* Start of the embedded code */
-    int savedExceptArrayNext)	/* Saved index of the end of the exception
-				 * range array */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
-				/* Current basic block */
-    int exceptionCount = envPtr->exceptArrayNext - savedExceptArrayNext;
-				/* Number of ranges that must be moved */
-    int i;
-
-    if (exceptionCount == 0) {
-	/* Nothing to do */
-	return;
-    }
-
-    /*
-     * Save the exception ranges in the basic block. They will be re-added at
-     * the conclusion of assembly; at this time, the INST_BEGIN_CATCH
-     * instructions in the block will be adjusted from whatever range indices
-     * they have [savedExceptArrayNext .. envPtr->exceptArrayNext) to the
-     * indices that the exceptions acquire. The saved exception ranges are
-     * converted to a relative nesting depth. The depth will be recomputed
-     * once flow analysis has determined the actual stack depth of the block.
-     */
-
-    DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n",
-	    curr_bb, exceptionCount, savedExceptArrayNext);
-    curr_bb->foreignExceptionBase = savedExceptArrayNext;
-    curr_bb->foreignExceptionCount = exceptionCount;
-    curr_bb->foreignExceptions =
-	    ckalloc(exceptionCount * sizeof(ExceptionRange));
-    memcpy(curr_bb->foreignExceptions,
-	    envPtr->exceptArrayPtr + savedExceptArrayNext,
-	    exceptionCount * sizeof(ExceptionRange));
-    for (i = 0; i < exceptionCount; ++i) {
-	curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth;
-    }
-    envPtr->exceptArrayNext = savedExceptArrayNext;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CreateMirrorJumpTable --
- *
- *	Makes a jump table with comparison values and assembly code labels.
- *
- * Results:
- *	Returns a standard Tcl status, with an error message in the
- *	interpreter on error.
- *
- * Side effects:
- *	Initializes the jump table pointer in the current basic block to a
- *	JumptableInfo. The keys in the JumptableInfo are the comparison
- *	strings. The values, instead of being jump displacements, are
- *	Tcl_Obj's with the code labels.
- */
-
-static int
-CreateMirrorJumpTable(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    Tcl_Obj* jumps)		/* List of alternating keywords and labels */
-{
-    int objc;			/* Number of elements in the 'jumps' list */
-    Tcl_Obj** objv;		/* Pointers to the elements in the list */
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
-				/* Current basic block */
-    JumptableInfo* jtPtr;
-    Tcl_HashTable* jtHashPtr;	/* Hashtable in the JumptableInfo */
-    Tcl_HashEntry* hashEntry;	/* Entry for a key in the hashtable */
-    int isNew;			/* Flag==1 if the key is not yet in the
-				 * table. */
-    int i;
-
-    if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if (objc % 2 != 0) {
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "jump table must have an even number of list elements",
-		    -1));
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Allocate the jumptable.
-     */
-
-    jtPtr = ckalloc(sizeof(JumptableInfo));
-    jtHashPtr = &jtPtr->hashTable;
-    Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);
-
-    /*
-     * Fill the keys and labels into the table.
-     */
-
-    DEBUG_PRINT("jump table {\n");
-    for (i = 0; i < objc; i+=2) {
-	DEBUG_PRINT("  %s -> %s\n", Tcl_GetString(objv[i]),
-		Tcl_GetString(objv[i+1]));
-	hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]),
-		&isNew);
-	if (!isNew) {
-	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"duplicate entry in jump table for \"%s\"",
-			Tcl_GetString(objv[i])));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
-		DeleteMirrorJumpTable(jtPtr);
-		return TCL_ERROR;
-	    }
-	}
-	Tcl_SetHashValue(hashEntry, objv[i+1]);
-	Tcl_IncrRefCount(objv[i+1]);
-    }
-    DEBUG_PRINT("}\n");
-
-    /*
-     * Put the mirror jumptable in the basic block struct.
-     */
-
-    bbPtr->jtPtr = jtPtr;
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * DeleteMirrorJumpTable --
- *
- *	Cleans up a jump table when the basic block is deleted.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-DeleteMirrorJumpTable(
-    JumptableInfo* jtPtr)
-{
-    Tcl_HashTable* jtHashPtr = &jtPtr->hashTable;
-				/* Hash table pointer */
-    Tcl_HashSearch search;	/* Hash search control */
-    Tcl_HashEntry* entry;	/* Hash table entry containing a jump label */
-    Tcl_Obj* label;		/* Jump label from the hash table */
-
-    for (entry = Tcl_FirstHashEntry(jtHashPtr, &search);
-	    entry != NULL;
-	    entry = Tcl_NextHashEntry(&search)) {
-	label = Tcl_GetHashValue(entry);
-	Tcl_DecrRefCount(label);
-	Tcl_SetHashValue(entry, NULL);
-    }
-    Tcl_DeleteHashTable(jtHashPtr);
-    ckfree(jtPtr);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * GetNextOperand --
- *
- *	Retrieves the next operand in sequence from an assembly instruction,
- *	and makes sure that its value is known at compile time.
- *
- * Results:
- *	If successful, returns TCL_OK and leaves a Tcl_Obj with the operand
- *	text in *operandObjPtr. In case of failure, returns TCL_ERROR and
- *	leaves *operandObjPtr untouched.
- *
- * Side effects:
- *	Advances *tokenPtrPtr around the token just processed.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-GetNextOperand(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    Tcl_Token** tokenPtrPtr,	/* INPUT/OUTPUT: Pointer to the token holding
-				 * the operand */
-    Tcl_Obj** operandObjPtr)	/* OUTPUT: Tcl object holding the operand text
-				 * with \-substitutions done. */
-{
-    Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr;
-    Tcl_Obj* operandObj = Tcl_NewObj();
-
-    if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
-	Tcl_DecrRefCount(operandObj);
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "assembly code may not contain substitutions", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
-	}
-	return TCL_ERROR;
-    }
-    *tokenPtrPtr = TokenAfter(*tokenPtrPtr);
-    Tcl_IncrRefCount(operandObj);
-    *operandObjPtr = operandObj;
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * GetBooleanOperand --
- *
- *	Retrieves a Boolean operand from the input stream and advances
- *	the token pointer.
- *
- * Results:
- *	Returns a standard Tcl result (with an error message in the
- *	interpreter on failure).
- *
- * Side effects:
- *	Stores the Boolean value in (*result) and advances (*tokenPtrPtr)
- *	to the next token.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-GetBooleanOperand(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
-    int* result)		/* OUTPUT: Integer extracted from the token */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    Tcl_Token* tokenPtr = *tokenPtrPtr;
-				/* INOUT: Pointer to the next token in the
-				 * source code */
-    Tcl_Obj* intObj;		/* Integer from the source code */
-    int status;			/* Tcl status return */
-
-    /*
-     * Extract the next token as a string.
-     */
-
-    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Convert to an integer, advance to the next token and return.
-     */
-
-    status = Tcl_GetBooleanFromObj(interp, intObj, result);
-    Tcl_DecrRefCount(intObj);
-    *tokenPtrPtr = TokenAfter(tokenPtr);
-    return status;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * GetIntegerOperand --
- *
- *	Retrieves an integer operand from the input stream and advances the
- *	token pointer.
- *
- * Results:
- *	Returns a standard Tcl result (with an error message in the
- *	interpreter on failure).
- *
- * Side effects:
- *	Stores the integer value in (*result) and advances (*tokenPtrPtr) to
- *	the next token.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-GetIntegerOperand(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
-    int* result)		/* OUTPUT: Integer extracted from the token */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    Tcl_Token* tokenPtr = *tokenPtrPtr;
-				/* INOUT: Pointer to the next token in the
-				 * source code */
-    Tcl_Obj* intObj;		/* Integer from the source code */
-    int status;			/* Tcl status return */
-
-    /*
-     * Extract the next token as a string.
-     */
-
-    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Convert to an integer, advance to the next token and return.
-     */
-
-    status = Tcl_GetIntFromObj(interp, intObj, result);
-    Tcl_DecrRefCount(intObj);
-    *tokenPtrPtr = TokenAfter(tokenPtr);
-    return status;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * GetListIndexOperand --
- *
- *	Gets the value of an operand intended to serve as a list index.
- *
- * Results:
- *	Returns a standard Tcl result: TCL_OK if the parse is successful and
- *	TCL_ERROR (with an appropriate error message) if the parse fails.
- *
- * Side effects:
- *	Stores the list index at '*index'. Values between -1 and 0x7fffffff
- *	have their natural meaning; values between -2 and -0x80000000
- *	represent 'end-2-N'.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-GetListIndexOperand(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
-    int* result)		/* OUTPUT: Integer extracted from the token */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    Tcl_Token* tokenPtr = *tokenPtrPtr;
-				/* INOUT: Pointer to the next token in the
-				 * source code */
-    Tcl_Obj* intObj;		/* Integer from the source code */
-    int status;			/* Tcl status return */
-
-    /*
-     * Extract the next token as a string.
-     */
-
-    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Convert to an integer, advance to the next token and return.
-     */
-
-    status = TclGetIntForIndex(interp, intObj, -2, result);
-    Tcl_DecrRefCount(intObj);
-    *tokenPtrPtr = TokenAfter(tokenPtr);
-    return status;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * FindLocalVar --
- *
- *	Gets the name of a local variable from the input stream and advances
- *	the token pointer.
- *
- * Results:
- *	Returns the LVT index of the local variable.  Returns -1 if the
- *	variable is non-local, not known at compile time, or cannot be
- *	installed in the LVT (leaving an error message in the interpreter
- *	result if necessary).
- *
- * Side effects:
- *	Advances the token pointer.  May define a new LVT slot if the variable
- *	has not yet been seen and the execution context allows for it.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-FindLocalVar(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    Tcl_Token** tokenPtrPtr)
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    Tcl_Token* tokenPtr = *tokenPtrPtr;
-				/* INOUT: Pointer to the next token in the
-				 * source code. */
-    Tcl_Obj* varNameObj;	/* Name of the variable */
-    const char* varNameStr;
-    int varNameLen;
-    int localVar;		/* Index of the variable in the LVT */
-
-    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
-	return -1;
-    }
-    varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
-    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
-	Tcl_DecrRefCount(varNameObj);
-	return -1;
-    }
-    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
-    Tcl_DecrRefCount(varNameObj);
-    if (localVar == -1) {
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "cannot use this instruction to create a variable"
-		    " in a non-proc context", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
-	}
-	return -1;
-    }
-    *tokenPtrPtr = TokenAfter(tokenPtr);
-    return localVar;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckNamespaceQualifiers --
- *
- *	Verify that a variable name has no namespace qualifiers before
- *	attempting to install it in the LVT.
- *
- * Results:
- *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
- *	an error message in the interpreter result.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckNamespaceQualifiers(
-    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
-    const char* name,		/* Variable name to check */
-    int nameLen)		/* Length of the variable */
-{
-    const char* p;
-
-    for (p = name; p+2 < name+nameLen;  p++) {
-	if ((*p == ':') && (p[1] == ':')) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "variable \"%s\" is not local", name));
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
-	    return TCL_ERROR;
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckOneByte --
- *
- *	Verify that a constant fits in a single byte in the instruction
- *	stream.
- *
- * Results:
- *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
- *	an error message in the interpreter result.
- *
- * This code is here primarily to verify that instructions like INCR_SCALAR1
- * are possible on a given local variable. The fact that there is no
- * INCR_SCALAR4 is puzzling.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckOneByte(
-    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
-    int value)			/* Value to check */
-{
-    Tcl_Obj* result;		/* Error message */
-
-    if (value < 0 || value > 0xff) {
-	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
-	Tcl_SetObjResult(interp, result);
-	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckSignedOneByte --
- *
- *	Verify that a constant fits in a single signed byte in the instruction
- *	stream.
- *
- * Results:
- *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
- *	an error message in the interpreter result.
- *
- * This code is here primarily to verify that instructions like INCR_SCALAR1
- * are possible on a given local variable. The fact that there is no
- * INCR_SCALAR4 is puzzling.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckSignedOneByte(
-    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
-    int value)			/* Value to check */
-{
-    Tcl_Obj* result;		/* Error message */
-
-    if (value > 0x7f || value < -0x80) {
-	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
-	Tcl_SetObjResult(interp, result);
-	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckNonNegative --
- *
- *	Verify that a constant is nonnegative
- *
- * Results:
- *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
- *	an error message in the interpreter result.
- *
- * This code is here primarily to verify that instructions like INCR_INVOKE
- * are consuming a positive number of operands
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckNonNegative(
-    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
-    int value)			/* Value to check */
-{
-    Tcl_Obj* result;		/* Error message */
-
-    if (value < 0) {
-	result = Tcl_NewStringObj("operand must be nonnegative", -1);
-	Tcl_SetObjResult(interp, result);
-	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckStrictlyPositive --
- *
- *	Verify that a constant is positive
- *
- * Results:
- *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
- *	stores an error message in the interpreter result.
- *
- * This code is here primarily to verify that instructions like INCR_INVOKE
- * are consuming a positive number of operands
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckStrictlyPositive(
-    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
-    int value)			/* Value to check */
-{
-    Tcl_Obj* result;		/* Error message */
-
-    if (value <= 0) {
-	result = Tcl_NewStringObj("operand must be positive", -1);
-	Tcl_SetObjResult(interp, result);
-	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * DefineLabel --
- *
- *	Defines a label appearing in the assembly sequence.
- *
- * Results:
- *	Returns a standard Tcl result. Returns TCL_OK and an empty result if
- *	the definition succeeds; returns TCL_ERROR and an appropriate message
- *	if a duplicate definition is found.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-DefineLabel(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    const char* labelName)	/* Label being defined */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    Tcl_HashEntry* entry;	/* Label's entry in the symbol table */
-    int isNew;			/* Flag == 1 iff the label was previously
-				 * undefined */
-
-    /* TODO - This can now be simplified! */
-
-    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
-
-    /*
-     * Look up the newly-defined label in the symbol table.
-     */
-
-    entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
-    if (!isNew) {
-	/*
-	 * This is a duplicate label.
-	 */
-
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "duplicate definition of label \"%s\"", labelName));
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
-		    NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * This is the first appearance of the label in the code.
-     */
-
-    Tcl_SetHashValue(entry, assemEnvPtr->curr_bb);
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * StartBasicBlock --
- *
- *	Starts a new basic block when a label or jump is encountered.
- *
- * Results:
- *	Returns a pointer to the BasicBlock structure of the new
- *	basic block.
- *
- *-----------------------------------------------------------------------------
- */
-
-static BasicBlock*
-StartBasicBlock(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int flags,			/* Flags to apply to the basic block being
-				 * closed, if there is one. */
-    Tcl_Obj* jumpLabel)		/* Label of the location that the block jumps
-				 * to, or NULL if the block does not jump */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* newBB;		/* BasicBlock structure for the new block */
-    BasicBlock* currBB = assemEnvPtr->curr_bb;
-
-    /*
-     * Coalesce zero-length blocks.
-     */
-
-    if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) {
-	currBB->startLine = assemEnvPtr->cmdLine;
-	return currBB;
-    }
-
-    /*
-     * Make the new basic block.
-     */
-
-    newBB = AllocBB(assemEnvPtr);
-
-    /*
-     * Record the jump target if there is one.
-     */
-
-    currBB->jumpTarget = jumpLabel;
-    if (jumpLabel != NULL) {
-	Tcl_IncrRefCount(currBB->jumpTarget);
-    }
-
-    /*
-     * Record the fallthrough if there is one.
-     */
-
-    currBB->flags |= flags;
-
-    /*
-     * Record the successor block.
-     */
-
-    currBB->successor1 = newBB;
-    assemEnvPtr->curr_bb = newBB;
-    return newBB;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * AllocBB --
- *
- *	Allocates a new basic block
- *
- * Results:
- *	Returns a pointer to the newly allocated block, which is initialized
- *	to contain no code and begin at the current instruction pointer.
- *
- *-----------------------------------------------------------------------------
- */
-
-static BasicBlock *
-AllocBB(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-    BasicBlock *bb = ckalloc(sizeof(BasicBlock));
-
-    bb->originalStartOffset =
-	    bb->startOffset = envPtr->codeNext - envPtr->codeStart;
-    bb->startLine = assemEnvPtr->cmdLine + 1;
-    bb->jumpOffset = -1;
-    bb->jumpLine = -1;
-    bb->prevPtr = assemEnvPtr->curr_bb;
-    bb->predecessor = NULL;
-    bb->successor1 = NULL;
-    bb->jumpTarget = NULL;
-    bb->initialStackDepth = 0;
-    bb->minStackDepth = 0;
-    bb->maxStackDepth = 0;
-    bb->finalStackDepth = 0;
-    bb->enclosingCatch = NULL;
-    bb->foreignExceptionBase = -1;
-    bb->foreignExceptionCount = 0;
-    bb->foreignExceptions = NULL;
-    bb->jtPtr = NULL;
-    bb->flags = 0;
-
-    return bb;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * FinishAssembly --
- *
- *	Postprocessing after all bytecode has been generated for a block of
- *	assembly code.
- *
- * Results:
- *	Returns a standard Tcl result, with an error message left in the
- *	interpreter if appropriate.
- *
- * Side effects:
- *	The program is checked to see if any undefined labels remain.  The
- *	initial stack depth of all the basic blocks in the flow graph is
- *	calculated and saved.  The stack balance on exit is computed, checked
- *	and saved.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-FinishAssembly(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    int mustMove;		/* Amount by which the code needs to be grown
-				 * because of expanding jumps */
-
-    /*
-     * Resolve the targets of all jumps and determine whether code needs to be
-     * moved around.
-     */
-
-    if (CalculateJumpRelocations(assemEnvPtr, &mustMove)) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Move the code if necessary.
-     */
-
-    if (mustMove) {
-	MoveCodeForJumps(assemEnvPtr, mustMove);
-    }
-
-    /*
-     * Resolve jump target labels to bytecode offsets.
-     */
-
-    FillInJumpOffsets(assemEnvPtr);
-
-    /*
-     * Label each basic block with its catch context. Quit on inconsistency.
-     */
-
-    if (ProcessCatches(assemEnvPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make sure that no block accessible from a catch's error exit that hasn't
-     * popped the exception stack can throw an exception.
-     */
-
-    if (CheckForThrowInWrongContext(assemEnvPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Compute stack balance throughout the program.
-     */
-
-    if (CheckStack(assemEnvPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * TODO - Check for unreachable code. Or maybe not; unreachable code is
-     * Mostly Harmless.
-     */
-
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CalculateJumpRelocations --
- *
- *	Calculate any movement that has to be done in the assembly code to
- *	expand JUMP1 instructions to JUMP4 (because they jump more than a
- *	1-byte range).
- *
- * Results:
- *	Returns a standard Tcl result, with an appropriate error message if
- *	anything fails.
- *
- * Side effects:
- *	Sets the 'startOffset' pointer in every basic block to the new origin
- *	of the block, and turns off JUMP1 flags on instructions that must be
- *	expanded (and adjusts them to the corresponding JUMP4's).  Does *not*
- *	store the jump offsets at this point.
- *
- *	Sets *mustMove to 1 if and only if at least one instruction changed
- *	size so the code must be moved.
- *
- *	As a side effect, also checks for undefined labels and reports them.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CalculateJumpRelocations(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    int* mustMove)		/* OUTPUT: Number of bytes that have been
-				 * added to the code */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
-    Tcl_HashEntry* entry;	/* Exit label's entry in the symbol table */
-    BasicBlock* jumpTarget;	/* Basic block where the jump goes */
-    int motion;			/* Amount by which the code has expanded */
-    int offset;			/* Offset in the bytecode from a jump
-				 * instruction to its target */
-    unsigned opcode;		/* Opcode in the bytecode being adjusted */
-
-    /*
-     * Iterate through basic blocks as long as a change results in code
-     * expansion.
-     */
-
-    *mustMove = 0;
-    do {
-	motion = 0;
-	for (bbPtr = assemEnvPtr->head_bb;
-		bbPtr != NULL;
-		bbPtr = bbPtr->successor1) {
-	    /*
-	     * Advance the basic block start offset by however many bytes we
-	     * have inserted in the code up to this point
-	     */
-
-	    bbPtr->startOffset += motion;
-
-	    /*
-	     * If the basic block references a label (and hence performs a
-	     * jump), find the location of the label. Report an error if the
-	     * label is missing.
-	     */
-
-	    if (bbPtr->jumpTarget != NULL) {
-		entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-			Tcl_GetString(bbPtr->jumpTarget));
-		if (entry == NULL) {
-		    ReportUndefinedLabel(assemEnvPtr, bbPtr,
-			    bbPtr->jumpTarget);
-		    return TCL_ERROR;
-		}
-
-		/*
-		 * If the instruction is a JUMP1, turn it into a JUMP4 if its
-		 * target is out of range.
-		 */
-
-		jumpTarget = Tcl_GetHashValue(entry);
-		if (bbPtr->flags & BB_JUMP1) {
-		    offset = jumpTarget->startOffset
-			    - (bbPtr->jumpOffset + motion);
-		    if (offset < -0x80 || offset > 0x7f) {
-			opcode = TclGetUInt1AtPtr(envPtr->codeStart
-				+ bbPtr->jumpOffset);
-			++opcode;
-			TclStoreInt1AtPtr(opcode,
-				envPtr->codeStart + bbPtr->jumpOffset);
-			motion += 3;
-			bbPtr->flags &= ~BB_JUMP1;
-		    }
-		}
-	    }
-
-	    /*
-	     * If the basic block references a jump table, that doesn't affect
-	     * the code locations, but resolve the labels now, and store basic
-	     * block pointers in the jumptable hash.
-	     */
-
-	    if (bbPtr->flags & BB_JUMPTABLE) {
-		if (CheckJumpTableLabels(assemEnvPtr, bbPtr) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-	    }
-	}
-	*mustMove += motion;
-    } while (motion != 0);
-
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckJumpTableLabels --
- *
- *	Make sure that all the labels in a jump table are defined.
- *
- * Results:
- *	Returns TCL_OK if they are, TCL_ERROR if they aren't.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckJumpTableLabels(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* bbPtr)		/* Basic block that ends in a jump table */
-{
-    Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
-				/* Hash table with the symbols */
-    Tcl_HashSearch search;	/* Hash table iterator */
-    Tcl_HashEntry* symEntryPtr;	/* Hash entry for the symbols */
-    Tcl_Obj* symbolObj;		/* Jump target */
-    Tcl_HashEntry* valEntryPtr;	/* Hash entry for the resolutions */
-
-    /*
-     * Look up every jump target in the jump hash.
-     */
-
-    DEBUG_PRINT("check jump table labels %p {\n", bbPtr);
-    for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
-	    symEntryPtr != NULL;
-	    symEntryPtr = Tcl_NextHashEntry(&search)) {
-	symbolObj = Tcl_GetHashValue(symEntryPtr);
-	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		Tcl_GetString(symbolObj));
-	DEBUG_PRINT("  %s -> %s (%d)\n",
-		(char*) Tcl_GetHashKey(symHash, symEntryPtr),
-		Tcl_GetString(symbolObj), (valEntryPtr != NULL));
-	if (valEntryPtr == NULL) {
-	    ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
-	    return TCL_ERROR;
-	}
-    }
-    DEBUG_PRINT("}\n");
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * ReportUndefinedLabel --
- *
- *	Report that a basic block refers to an undefined jump label
- *
- * Side effects:
- *	Stores an error message, error code, and line number information in
- *	the assembler's Tcl interpreter.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-ReportUndefinedLabel(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* bbPtr,		/* Basic block that contains the undefined
-				 * label */
-    Tcl_Obj* jumpTarget)	/* Label of a jump target */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-
-    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"undefined label \"%s\"", Tcl_GetString(jumpTarget)));
-	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
-		Tcl_GetString(jumpTarget), NULL);
-	Tcl_SetErrorLine(interp, bbPtr->jumpLine);
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * MoveCodeForJumps --
- *
- *	Move bytecodes in memory to accommodate JUMP1 instructions that have
- *	expanded to become JUMP4's.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-MoveCodeForJumps(
-    AssemblyEnv* assemEnvPtr,	/* Assembler environment */
-    int mustMove)		/* Number of bytes of added code */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
-    int topOffset;		/* Bytecode offset of the following basic
-				 * block before code motion */
-
-    /*
-     * Make sure that there is enough space in the bytecode array to
-     * accommodate the expanded code.
-     */
-
-    while (envPtr->codeEnd < envPtr->codeNext + mustMove) {
-	TclExpandCodeArray(envPtr);
-    }
-
-    /*
-     * Iterate through the bytecodes in reverse order, and move them upward to
-     * their new homes.
-     */
-
-    topOffset = envPtr->codeNext - envPtr->codeStart;
-    for (bbPtr = assemEnvPtr->curr_bb; bbPtr != NULL; bbPtr = bbPtr->prevPtr) {
-	DEBUG_PRINT("move code from %d to %d\n",
-		bbPtr->originalStartOffset, bbPtr->startOffset);
-	memmove(envPtr->codeStart + bbPtr->startOffset,
-		envPtr->codeStart + bbPtr->originalStartOffset,
-		topOffset - bbPtr->originalStartOffset);
-	topOffset = bbPtr->originalStartOffset;
-	bbPtr->jumpOffset += (bbPtr->startOffset - bbPtr->originalStartOffset);
-    }
-    envPtr->codeNext += mustMove;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * FillInJumpOffsets --
- *
- *	Fill in the final offsets of all jump instructions once bytecode
- *	locations have been completely determined.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-FillInJumpOffsets(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
-    Tcl_HashEntry* entry;	/* Hashtable entry for a jump target label */
-    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
-    int fromOffset;		/* Bytecode location of a jump instruction */
-    int targetOffset;		/* Bytecode location of a jump instruction's
-				 * target */
-
-    for (bbPtr = assemEnvPtr->head_bb;
-	    bbPtr != NULL;
-	    bbPtr = bbPtr->successor1) {
-	if (bbPtr->jumpTarget != NULL) {
-	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    Tcl_GetString(bbPtr->jumpTarget));
-	    jumpTarget = Tcl_GetHashValue(entry);
-	    fromOffset = bbPtr->jumpOffset;
-	    targetOffset = jumpTarget->startOffset;
-	    if (bbPtr->flags & BB_JUMP1) {
-		TclStoreInt1AtPtr(targetOffset - fromOffset,
-			envPtr->codeStart + fromOffset + 1);
-	    } else {
-		TclStoreInt4AtPtr(targetOffset - fromOffset,
-			envPtr->codeStart + fromOffset + 1);
-	    }
-	}
-	if (bbPtr->flags & BB_JUMPTABLE) {
-	    ResolveJumpTableTargets(assemEnvPtr, bbPtr);
-	}
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * ResolveJumpTableTargets --
- *
- *	Puts bytecode addresses for the targets of a jumptable into the
- *	table
- *
- * Results:
- *	Returns TCL_OK if they are, TCL_ERROR if they aren't.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-ResolveJumpTableTargets(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* bbPtr)		/* Basic block that ends in a jump table */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
-				/* Hash table with the symbols */
-    Tcl_HashSearch search;	/* Hash table iterator */
-    Tcl_HashEntry* symEntryPtr;	/* Hash entry for the symbols */
-    Tcl_Obj* symbolObj;		/* Jump target */
-    Tcl_HashEntry* valEntryPtr;	/* Hash entry for the resolutions */
-    int auxDataIndex;		/* Index of the auxdata */
-    JumptableInfo* realJumpTablePtr;
-				/* Jump table in the actual code */
-    Tcl_HashTable* realJumpHashPtr;
-				/* Jump table hash in the actual code */
-    Tcl_HashEntry* realJumpEntryPtr;
-				/* Entry in the jump table hash in
-				 * the actual code */
-    BasicBlock* jumpTargetBBPtr;
-				/* Basic block that the jump proceeds to */
-    int junk;
-
-    auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
-    DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
-	    bbPtr, bbPtr->jumpOffset, auxDataIndex);
-    realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
-    realJumpHashPtr = &realJumpTablePtr->hashTable;
-
-    /*
-     * Look up every jump target in the jump hash.
-     */
-
-    DEBUG_PRINT("resolve jump table {\n");
-    for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
-	    symEntryPtr != NULL;
-	    symEntryPtr = Tcl_NextHashEntry(&search)) {
-	symbolObj = Tcl_GetHashValue(symEntryPtr);
-	DEBUG_PRINT("     symbol %s\n", Tcl_GetString(symbolObj));
-
-	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		Tcl_GetString(symbolObj));
-	jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr);
-
-	realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
-		Tcl_GetHashKey(symHash, symEntryPtr), &junk);
-	DEBUG_PRINT("  %s -> %s -> bb %p (pc %d)    hash entry %p\n",
-		(char*) Tcl_GetHashKey(symHash, symEntryPtr),
-		Tcl_GetString(symbolObj), jumpTargetBBPtr,
-		jumpTargetBBPtr->startOffset, realJumpEntryPtr);
-
-	Tcl_SetHashValue(realJumpEntryPtr,
-		INT2PTR(jumpTargetBBPtr->startOffset - bbPtr->jumpOffset));
-    }
-    DEBUG_PRINT("}\n");
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckForThrowInWrongContext --
- *
- *	Verify that no beginCatch/endCatch sequence can throw an exception
- *	after an original exception is caught and before its exception context
- *	is removed from the stack.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	Stores an appropriate error message in the interpreter as needed.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckForThrowInWrongContext(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    BasicBlock* blockPtr;	/* Current basic block */
-
-    /*
-     * Walk through the basic blocks in turn, checking all the ones that have
-     * caught an exception and not disposed of it properly.
-     */
-
-    for (blockPtr = assemEnvPtr->head_bb;
-	    blockPtr != NULL;
-	    blockPtr = blockPtr->successor1) {
-	if (blockPtr->catchState == BBCS_CAUGHT) {
-	    /*
-	     * Walk through the instructions in the basic block.
-	     */
-
-	    if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckNonThrowingBlock --
- *
- *	Check that a basic block cannot throw an exception.
- *
- * Results:
- *	Returns TCL_ERROR if the block cannot be proven to be nonthrowing.
- *
- * Side effects:
- *	Stashes an error message in the interpreter result.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckNonThrowingBlock(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* blockPtr)	/* Basic block where exceptions are not
-				 * allowed */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    BasicBlock* nextPtr;	/* Pointer to the succeeding basic block */
-    int offset;			/* Bytecode offset of the current
-				 * instruction */
-    int bound;			/* Bytecode offset following the last
-				 * instruction of the block. */
-    unsigned char opcode;	/* Current bytecode instruction */
-
-    /*
-     * Determine where in the code array the basic block ends.
-     */
-
-    nextPtr = blockPtr->successor1;
-    if (nextPtr == NULL) {
-	bound = envPtr->codeNext - envPtr->codeStart;
-    } else {
-	bound = nextPtr->startOffset;
-    }
-
-    /*
-     * Walk through the instructions of the block.
-     */
-
-    offset = blockPtr->startOffset;
-    while (offset < bound) {
-	/*
-	 * Determine whether an instruction is nonthrowing.
-	 */
-
-	opcode = (envPtr->codeStart)[offset];
-	if (BytecodeMightThrow(opcode)) {
-	    /*
-	     * Report an error for a throw in the wrong context.
-	     */
-
-	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"\"%s\" instruction may not appear in "
-			"a context where an exception has been "
-			"caught and not disposed of.",
-			tclInstructionTable[opcode].name));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
-		AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
-	    }
-	    return TCL_ERROR;
-	}
-	offset += tclInstructionTable[opcode].numBytes;
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * BytecodeMightThrow --
- *
- *	Tests if a given bytecode instruction might throw an exception.
- *
- * Results:
- *	Returns 1 if the bytecode might throw an exception, 0 if the
- *	instruction is known never to throw.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-BytecodeMightThrow(
-    unsigned char opcode)
-{
-    /*
-     * Binary search on the non-throwing bytecode list.
-     */
-
-    int min = 0;
-    int max = sizeof(NonThrowingByteCodes) - 1;
-    int mid;
-    unsigned char c;
-
-    while (max >= min) {
-	mid = (min + max) / 2;
-	c = NonThrowingByteCodes[mid];
-	if (opcode < c) {
-	    max = mid-1;
-	} else if (opcode > c) {
-	    min = mid+1;
-	} else {
-	    /*
-	     * Opcode is nonthrowing.
-	     */
-
-	    return 0;
-	}
-    }
-
-    return 1;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckStack --
- *
- *	Audit stack usage in a block of assembly code.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	Updates stack depth on entry for all basic blocks in the flowgraph.
- *	Calculates the max stack depth used in the program, and updates the
- *	compilation environment to reflect it.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckStack(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    int maxDepth;		/* Maximum stack depth overall */
-
-    /*
-     * Checking the head block will check all the other blocks recursively.
-     */
-
-    assemEnvPtr->maxDepth = 0;
-    if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL,
-	    0) == TCL_ERROR) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Post the max stack depth back to the compilation environment.
-     */
-
-    maxDepth = assemEnvPtr->maxDepth + envPtr->currStackDepth;
-    if (maxDepth > envPtr->maxStackDepth) {
-	envPtr->maxStackDepth = maxDepth;
-    }
-
-    /*
-     * If the exit is reachable, make sure that the program exits with 1
-     * operand on the stack.
-     */
-
-    if (StackCheckExit(assemEnvPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Reset the visited state on all basic blocks.
-     */
-
-    ResetVisitedBasicBlocks(assemEnvPtr);
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * StackCheckBasicBlock --
- *
- *	Checks stack consumption for a basic block (and recursively for its
- *	successors).
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	Updates initial stack depth for the basic block and its successors.
- *	(Final and maximum stack depth are relative to initial, and are not
- *	touched).
- *
- * This procedure eventually checks, for the entire flow graph, whether stack
- * balance is consistent.  It is an error for a given basic block to be
- * reachable along multiple flow paths with different stack depths.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-StackCheckBasicBlock(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* blockPtr,	/* Pointer to the basic block being checked */
-    BasicBlock* predecessor,	/* Pointer to the block that passed control to
-				 * this one. */
-    int initialStackDepth)	/* Stack depth on entry to the block */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
-    int stackDepth;		/* Current stack depth */
-    int maxDepth;		/* Maximum stack depth so far */
-    int result;			/* Tcl status return */
-    Tcl_HashSearch jtSearch;	/* Search structure for the jump table */
-    Tcl_HashEntry* jtEntry;	/* Hash entry in the jump table */
-    Tcl_Obj* targetLabel;	/* Target label from the jump table */
-    Tcl_HashEntry* entry;	/* Hash entry in the label table */
-
-    if (blockPtr->flags & BB_VISITED) {
-	/*
-	 * If the block is already visited, check stack depth for consistency
-	 * among the paths that reach it.
-	 */
-
-	if (blockPtr->initialStackDepth == initialStackDepth) {
-	    return TCL_OK;
-	}
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "inconsistent stack depths on two execution paths", -1));
-
-	    /*
-	     * TODO - add execution trace of both paths
-	     */
-
-	    Tcl_SetErrorLine(interp, blockPtr->startLine);
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * If the block is not already visited, set the 'predecessor' link to
-     * indicate how control got to it. Set the initial stack depth to the
-     * current stack depth in the flow of control.
-     */
-
-    blockPtr->flags |= BB_VISITED;
-    blockPtr->predecessor = predecessor;
-    blockPtr->initialStackDepth = initialStackDepth;
-
-    /*
-     * Calculate minimum stack depth, and flag an error if the block
-     * underflows the stack.
-     */
-
-    if (initialStackDepth + blockPtr->minStackDepth < 0) {
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
-	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
-	    Tcl_SetErrorLine(interp, blockPtr->startLine);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make sure that the block doesn't try to pop below the stack level of an
-     * enclosing catch.
-     */
-
-    if (blockPtr->enclosingCatch != 0 &&
-	    initialStackDepth + blockPtr->minStackDepth
-	    < (blockPtr->enclosingCatch->initialStackDepth
-		+ blockPtr->enclosingCatch->finalStackDepth)) {
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "code pops stack below level of enclosing catch", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1);
-	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
-	    Tcl_SetErrorLine(interp, blockPtr->startLine);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Update maximum stgack depth.
-     */
-
-    maxDepth = initialStackDepth + blockPtr->maxStackDepth;
-    if (maxDepth > assemEnvPtr->maxDepth) {
-	assemEnvPtr->maxDepth = maxDepth;
-    }
-
-    /*
-     * Calculate stack depth on exit from the block, and invoke this procedure
-     * recursively to check successor blocks.
-     */
-
-    stackDepth = initialStackDepth + blockPtr->finalStackDepth;
-    result = TCL_OK;
-    if (blockPtr->flags & BB_FALLTHRU) {
-	result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1,
-		blockPtr, stackDepth);
-    }
-
-    if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
-	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		Tcl_GetString(blockPtr->jumpTarget));
-	jumpTarget = Tcl_GetHashValue(entry);
-	result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
-		stackDepth);
-    }
-
-    /*
-     * All blocks referenced in a jump table are successors.
-     */
-
-    if (blockPtr->flags & BB_JUMPTABLE) {
-	for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable,
-		    &jtSearch);
-		result == TCL_OK && jtEntry != NULL;
-		jtEntry = Tcl_NextHashEntry(&jtSearch)) {
-	    targetLabel = Tcl_GetHashValue(jtEntry);
-	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    Tcl_GetString(targetLabel));
-	    jumpTarget = Tcl_GetHashValue(entry);
-	    result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
-		    blockPtr, stackDepth);
-	}
-    }
-
-    return result;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * StackCheckExit --
- *
- *	Makes sure that the net stack effect of an entire assembly language
- *	script is to push 1 result.
- *
- * Results:
- *	Returns a standard Tcl result, with an error message in the
- *	interpreter result if the stack is wrong.
- *
- * Side effects:
- *	If the assembly code had a net stack effect of zero, emits code to the
- *	concluding block to push a null result. In any case, updates the stack
- *	depth in the compile environment to reflect the net effect of the
- *	assembly code.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-StackCheckExit(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    int depth;			/* Net stack effect */
-    int litIndex;		/* Index in the literal pool of the empty
-				 * string */
-    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
-				/* Final basic block in the assembly */
-
-    /*
-     * Don't perform these checks if execution doesn't reach the exit (either
-     * because of an infinite loop or because the only return is from the
-     * middle.
-     */
-
-    if (curr_bb->flags & BB_VISITED) {
-	/*
-	 * Exit with no operands; push an empty one.
-	 */
-
-	depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
-	if (depth == 0) {
-	    /*
-	     * Emit a 'push' of the empty literal.
-	     */
-
-	    litIndex = TclRegisterNewLiteral(envPtr, "", 0);
-
-	    /*
-	     * Assumes that 'push' is at slot 0 in TalInstructionTable.
-	     */
-
-	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
-	    ++depth;
-	}
-
-	/*
-	 * Exit with unbalanced stack.
-	 */
-
-	if (depth != 1) {
-	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"stack is unbalanced on exit from the code (depth=%d)",
-			depth));
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Record stack usage.
-	 */
-
-	envPtr->currStackDepth += depth;
-    }
-
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * ProcessCatches --
- *
- *	First pass of 'catch' processing.
- *
- * Results:
- *	Returns a standard Tcl result, with an appropriate error message if
- *	the result is TCL_ERROR.
- *
- * Side effects:
- *	Labels all basic blocks with their enclosing catches.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-ProcessCatches(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    BasicBlock* blockPtr;	/* Pointer to a basic block */
-
-    /*
-     * Clear the catch state of all basic blocks.
-     */
-
-    for (blockPtr = assemEnvPtr->head_bb;
-	    blockPtr != NULL;
-	    blockPtr = blockPtr->successor1) {
-	blockPtr->catchState = BBCS_UNKNOWN;
-	blockPtr->enclosingCatch = NULL;
-    }
-
-    /*
-     * Start the check recursively from the first basic block, which is
-     * outside any exception context
-     */
-
-    if (ProcessCatchesInBasicBlock(assemEnvPtr, assemEnvPtr->head_bb,
-	    NULL, BBCS_NONE, 0) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Check for unclosed catch on exit.
-     */
-
-    if (CheckForUnclosedCatches(assemEnvPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Now there's enough information to build the exception ranges.
-     */
-
-    if (BuildExceptionRanges(assemEnvPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Finally, restore any exception ranges from embedded scripts.
-     */
-
-    RestoreEmbeddedExceptionRanges(assemEnvPtr);
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * ProcessCatchesInBasicBlock --
- *
- *	First-pass catch processing for one basic block.
- *
- * Results:
- *	Returns a standard Tcl result, with error message in the interpreter
- *	result if an error occurs.
- *
- * This procedure checks consistency of the exception context through the
- * assembler program, and records the enclosing 'catch' for every basic block.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-ProcessCatchesInBasicBlock(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* bbPtr,		/* Basic block being processed */
-    BasicBlock* enclosing,	/* Start basic block of the enclosing catch */
-    enum BasicBlockCatchState state,
-				/* BBCS_NONE, BBCS_INCATCH, or BBCS_CAUGHT */
-    int catchDepth)		/* Depth of nesting of catches */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    int result;			/* Return value from this procedure */
-    BasicBlock* fallThruEnclosing;
-				/* Enclosing catch if execution falls thru */
-    enum BasicBlockCatchState fallThruState;
-				/* Catch state of the successor block */
-    BasicBlock* jumpEnclosing;	/* Enclosing catch if execution goes to jump
-				 * target */
-    enum BasicBlockCatchState jumpState;
-				/* Catch state of the jump target */
-    int changed = 0;		/* Flag == 1 iff successor blocks need to be
-				 * checked because the state of this block has
-				 * changed. */
-    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
-    Tcl_HashSearch jtSearch;	/* Hash search control for a jumptable */
-    Tcl_HashEntry* jtEntry;	/* Entry in a jumptable */
-    Tcl_Obj* targetLabel;	/* Target label from a jumptable */
-    Tcl_HashEntry* entry;	/* Entry from the label table */
-
-    /*
-     * Update the state of the current block, checking for consistency.  Set
-     * 'changed' to 1 if the state changes and successor blocks need to be
-     * rechecked.
-     */
-
-    if (bbPtr->catchState == BBCS_UNKNOWN) {
-	bbPtr->enclosingCatch = enclosing;
-    } else if (bbPtr->enclosingCatch != enclosing) {
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "execution reaches an instruction in inconsistent "
-		    "exception contexts", -1));
-	    Tcl_SetErrorLine(interp, bbPtr->startLine);
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
-	}
-	return TCL_ERROR;
-    }
-    if (state > bbPtr->catchState) {
-	bbPtr->catchState = state;
-	changed = 1;
-    }
-
-    /*
-     * If this block has been visited before, and its state hasn't changed,
-     * we're done with it for now.
-     */
-
-    if (!changed) {
-	return TCL_OK;
-    }
-    bbPtr->catchDepth = catchDepth;
-
-    /*
-     * Determine enclosing catch and 'caught' state for the fallthrough and
-     * the jump target. Default for both is the state of the current block.
-     */
-
-    fallThruEnclosing = enclosing;
-    fallThruState = state;
-    jumpEnclosing = enclosing;
-    jumpState = state;
-
-    /*
-     * TODO: Make sure that the test cases include validating that a natural
-     * loop can't include 'beginCatch' or 'endCatch'
-     */
-
-    if (bbPtr->flags & BB_BEGINCATCH) {
-	/*
-	 * If the block begins a catch, the state for the successor is 'in
-	 * catch'. The jump target is the exception exit, and the state of the
-	 * jump target is 'caught.'
-	 */
-
-	fallThruEnclosing = bbPtr;
-	fallThruState = BBCS_INCATCH;
-	jumpEnclosing = bbPtr;
-	jumpState = BBCS_CAUGHT;
-	++catchDepth;
-    }
-
-    if (bbPtr->flags & BB_ENDCATCH) {
-	/*
-	 * If the block ends a catch, the state for the successor is whatever
-	 * the state was on entry to the catch.
-	 */
-
-	if (enclosing == NULL) {
-	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"endCatch without a corresponding beginCatch", -1));
-		Tcl_SetErrorLine(interp, bbPtr->startLine);
-		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	fallThruEnclosing = enclosing->enclosingCatch;
-	fallThruState = enclosing->catchState;
-	--catchDepth;
-    }
-
-    /*
-     * Visit any successor blocks with the appropriate exception context
-     */
-
-    result = TCL_OK;
-    if (bbPtr->flags & BB_FALLTHRU) {
-	result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1,
-		fallThruEnclosing, fallThruState, catchDepth);
-    }
-    if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
-	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		Tcl_GetString(bbPtr->jumpTarget));
-	jumpTarget = Tcl_GetHashValue(entry);
-	result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
-		jumpEnclosing, jumpState, catchDepth);
-    }
-
-    /*
-     * All blocks referenced in a jump table are successors.
-     */
-
-    if (bbPtr->flags & BB_JUMPTABLE) {
-	for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch);
-		result == TCL_OK && jtEntry != NULL;
-		jtEntry = Tcl_NextHashEntry(&jtSearch)) {
-	    targetLabel = Tcl_GetHashValue(jtEntry);
-	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    Tcl_GetString(targetLabel));
-	    jumpTarget = Tcl_GetHashValue(entry);
-	    result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
-		    jumpEnclosing, jumpState, catchDepth);
-	}
-    }
-
-    return result;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * CheckForUnclosedCatches --
- *
- *	Checks that a sequence of assembly code has no unclosed catches on
- *	exit.
- *
- * Results:
- *	Returns a standard Tcl result, with an error message for unclosed
- *	catches.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-CheckForUnclosedCatches(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-
-    if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) {
-	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "catch still active on exit from assembly code", -1));
-	    Tcl_SetErrorLine(interp,
-		    assemEnvPtr->curr_bb->enclosingCatch->startLine);
-	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
-	}
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * BuildExceptionRanges --
- *
- *	Walks through the assembly code and builds exception ranges for the
- *	catches embedded therein.
- *
- * Results:
- *	Returns a standard Tcl result with an error message in the interpreter
- *	if anything is unsuccessful.
- *
- * Side effects:
- *	Each contiguous block of code with a given catch exit is assigned an
- *	exception range at the appropriate level.
- *	Exception ranges in embedded blocks have their levels corrected and
- *	collated into the table.
- *	Blocks that end with 'beginCatch' are associated with the innermost
- *	exception range of the following block.
- *
- *-----------------------------------------------------------------------------
- */
-
-static int
-BuildExceptionRanges(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr;		/* Current basic block */
-    BasicBlock* prevPtr = NULL;	/* Previous basic block */
-    int catchDepth = 0;		/* Current catch depth */
-    int maxCatchDepth = 0;	/* Maximum catch depth in the program */
-    BasicBlock** catches;	/* Stack of catches in progress */
-    int* catchIndices;		/* Indices of the exception ranges of catches
-				 * in progress */
-    int i;
-
-    /*
-     * Determine the max catch depth for the entire assembly script
-     * (excluding embedded eval's and expr's, which will be handled later).
-     */
-
-    for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
-	if (bbPtr->catchDepth > maxCatchDepth) {
-	    maxCatchDepth = bbPtr->catchDepth;
-	}
-    }
-
-    /*
-     * Allocate memory for a stack of active catches.
-     */
-
-    catches = ckalloc(maxCatchDepth * sizeof(BasicBlock*));
-    catchIndices = ckalloc(maxCatchDepth * sizeof(int));
-    for (i = 0; i < maxCatchDepth; ++i) {
-	catches[i] = NULL;
-	catchIndices[i] = -1;
-    }
-
-    /*
-     * Walk through the basic blocks and manage exception ranges.
-     */
-
-    for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
-	UnstackExpiredCatches(envPtr, bbPtr, catchDepth, catches,
-		catchIndices);
-	LookForFreshCatches(bbPtr, catches);
-	StackFreshCatches(assemEnvPtr, bbPtr, catchDepth, catches,
-		catchIndices);
-
-	/*
-	 * If the last block was a 'begin catch', fill in the exception range.
-	 */
-
-	catchDepth = bbPtr->catchDepth;
-	if (prevPtr != NULL && (prevPtr->flags & BB_BEGINCATCH)) {
-	    TclStoreInt4AtPtr(catchIndices[catchDepth-1],
-		    envPtr->codeStart + bbPtr->startOffset - 4);
-	}
-
-	prevPtr = bbPtr;
-    }
-
-    /* Make sure that all catches are closed */
-
-    if (catchDepth != 0) {
-	Tcl_Panic("unclosed catch at end of code in "
-		"tclAssembly.c:BuildExceptionRanges, can't happen");
-    }
-
-    /* Free temp storage */
-
-    ckfree(catchIndices);
-    ckfree(catches);
-
-    return TCL_OK;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * UnstackExpiredCatches --
- *
- *	Unstacks and closes the exception ranges for any catch contexts that
- *	were active in the previous basic block but are inactive in the
- *	current one.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-UnstackExpiredCatches(
-    CompileEnv* envPtr,		/* Compilation environment */
-    BasicBlock* bbPtr,		/* Basic block being processed */
-    int catchDepth,		/* Depth of nesting of catches prior to entry
-				 * to this block */
-    BasicBlock** catches,	/* Array of catch contexts */
-    int* catchIndices)		/* Indices of the exception ranges
-				 * corresponding to the catch contexts */
-{
-    ExceptionRange* range;	/* Exception range for a specific catch */
-    BasicBlock* catch;		/* Catch block being examined */
-    BasicBlockCatchState catchState;
-				/* State of the code relative to the catch
-				 * block being examined ("in catch" or
-				 * "caught"). */
-
-    /*
-     * Unstack any catches that are deeper than the nesting level of the basic
-     * block being entered.
-     */
-
-    while (catchDepth > bbPtr->catchDepth) {
-	--catchDepth;
-	range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
-	range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
-	catches[catchDepth] = NULL;
-	catchIndices[catchDepth] = -1;
-    }
-
-    /*
-     * Unstack any catches that don't match the basic block being entered,
-     * either because they are no longer part of the context, or because the
-     * context has changed from INCATCH to CAUGHT.
-     */
-
-    catchState = bbPtr->catchState;
-    catch = bbPtr->enclosingCatch;
-    while (catchDepth > 0) {
-	--catchDepth;
-	if (catches[catchDepth] != NULL) {
-	    if (catches[catchDepth] != catch || catchState >= BBCS_CAUGHT) {
-		range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
-		range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
-		catches[catchDepth] = NULL;
-		catchIndices[catchDepth] = -1;
-	    }
-	    catchState = catch->catchState;
-	    catch = catch->enclosingCatch;
-	}
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * LookForFreshCatches --
- *
- *	Determines whether a basic block being entered needs any exception
- *	ranges that are not already stacked.
- *
- * Does not create the ranges: this procedure iterates from the innermost
- * catch outward, but exception ranges must be created from the outermost
- * catch inward.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-LookForFreshCatches(
-    BasicBlock* bbPtr,		/* Basic block being entered */
-    BasicBlock** catches)	/* Array of catch contexts that are already
-				 * entered */
-{
-    BasicBlockCatchState catchState;
-				/* State ("in catch" or "caught") of the
-				 * current catch. */
-    BasicBlock* catch;		/* Current enclosing catch */
-    int catchDepth;		/* Nesting depth of the current catch */
-
-    catchState = bbPtr->catchState;
-    catch = bbPtr->enclosingCatch;
-    catchDepth = bbPtr->catchDepth;
-    while (catchDepth > 0) {
-	--catchDepth;
-	if (catches[catchDepth] != catch && catchState < BBCS_CAUGHT) {
-	    catches[catchDepth] = catch;
-	}
-	catchState = catch->catchState;
-	catch = catch->enclosingCatch;
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * StackFreshCatches --
- *
- *	Make ExceptionRange records for any catches that are in the basic
- *	block being entered and were not in the previous basic block.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-StackFreshCatches(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* bbPtr,		/* Basic block being processed */
-    int catchDepth,		/* Depth of nesting of catches prior to entry
-				 * to this block */
-    BasicBlock** catches,	/* Array of catch contexts */
-    int* catchIndices)		/* Indices of the exception ranges
-				 * corresponding to the catch contexts */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    ExceptionRange* range;	/* Exception range for a specific catch */
-    BasicBlock* catch;		/* Catch block being examined */
-    BasicBlock* errorExit;	/* Error exit from the catch block */
-    Tcl_HashEntry* entryPtr;
-
-    catchDepth = 0;
-
-    /*
-     * Iterate through the enclosing catch blocks from the outside in,
-     * looking for ones that don't have exception ranges (and are uncaught)
-     */
-
-    for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) {
-	if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) {
-	    /*
-	     * Create an exception range for a block that needs one.
-	     */
-
-	    catch = catches[catchDepth];
-	    catchIndices[catchDepth] =
-		    TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-	    range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
-	    range->nestingLevel = envPtr->exceptDepth + catchDepth;
-	    envPtr->maxExceptDepth =
-		    TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth);
-	    range->codeOffset = bbPtr->startOffset;
-
-	    entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
-		    Tcl_GetString(catch->jumpTarget));
-	    if (entryPtr == NULL) {
-		Tcl_Panic("undefined label in tclAssembly.c:"
-			"BuildExceptionRanges, can't happen");
-	    }
-
-	    errorExit = Tcl_GetHashValue(entryPtr);
-	    range->catchOffset = errorExit->startOffset;
-	}
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * RestoreEmbeddedExceptionRanges --
- *
- *	Processes an assembly script, replacing any exception ranges that
- *	were present in embedded code.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-RestoreEmbeddedExceptionRanges(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    BasicBlock* bbPtr;		/* Current basic block */
-    int rangeBase;		/* Base of the foreign exception ranges when
-				 * they are reinstalled */
-    int rangeIndex;		/* Index of the current foreign exception
-				 * range as reinstalled */
-    ExceptionRange* range;	/* Current foreign exception range */
-    unsigned char opcode;	/* Current instruction's opcode */
-    int catchIndex;		/* Index of the exception range to which the
-				 * current instruction refers */
-    int i;
-
-    /*
-     * Walk the basic blocks looking for exceptions in embedded scripts.
-     */
-
-    for (bbPtr = assemEnvPtr->head_bb;
-	    bbPtr != NULL;
-	    bbPtr = bbPtr->successor1) {
-	if (bbPtr->foreignExceptionCount != 0) {
-	    /*
-	     * Reinstall the embedded exceptions and track their nesting level
-	     */
-
-	    rangeBase = envPtr->exceptArrayNext;
-	    for (i = 0; i < bbPtr->foreignExceptionCount; ++i) {
-		range = bbPtr->foreignExceptions + i;
-		rangeIndex = TclCreateExceptRange(range->type, envPtr);
-		range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth;
-		memcpy(envPtr->exceptArrayPtr + rangeIndex, range,
-			sizeof(ExceptionRange));
-		if (range->nestingLevel >= envPtr->maxExceptDepth) {
-		    envPtr->maxExceptDepth = range->nestingLevel + 1;
-		}
-	    }
-
-	    /*
-	     * Walk through the bytecode of the basic block, and relocate
-	     * INST_BEGIN_CATCH4 instructions to the new locations
-	     */
-
-	    i = bbPtr->startOffset;
-	    while (i < bbPtr->successor1->startOffset) {
-		opcode = envPtr->codeStart[i];
-		if (opcode == INST_BEGIN_CATCH4) {
-		    catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1);
-		    if (catchIndex >= bbPtr->foreignExceptionBase
-			    && catchIndex < (bbPtr->foreignExceptionBase +
-			    bbPtr->foreignExceptionCount)) {
-			catchIndex -= bbPtr->foreignExceptionBase;
-			catchIndex += rangeBase;
-			TclStoreInt4AtPtr(catchIndex, envPtr->codeStart+i+1);
-		    }
-		}
-		i += tclInstructionTable[opcode].numBytes;
-	    }
-	}
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * ResetVisitedBasicBlocks --
- *
- *	Turns off the 'visited' flag in all basic blocks at the conclusion
- *	of a pass.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-ResetVisitedBasicBlocks(
-    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
-{
-    BasicBlock* block;
-
-    for (block = assemEnvPtr->head_bb; block != NULL;
-	    block = block->successor1) {
-	block->flags &= ~BB_VISITED;
-    }
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * AddBasicBlockRangeToErrorInfo --
- *
- *	Updates the error info of the Tcl interpreter to show a given basic
- *	block in the code.
- *
- * This procedure is used to label the callstack with source location
- * information when reporting an error in stack checking.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-AddBasicBlockRangeToErrorInfo(
-    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
-    BasicBlock* bbPtr)		/* Basic block in which the error is found */
-{
-    CompileEnv* envPtr = assemEnvPtr->envPtr;
-				/* Compilation environment */
-    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
-				/* Tcl interpreter */
-    Tcl_Obj* lineNo;		/* Line number in the source */
-
-    Tcl_AddErrorInfo(interp, "\n    in assembly code between lines ");
-    lineNo = Tcl_NewIntObj(bbPtr->startLine);
-    Tcl_IncrRefCount(lineNo);
-    Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
-    Tcl_AddErrorInfo(interp, " and ");
-    if (bbPtr->successor1 != NULL) {
-	Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
-	Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo));
-    } else {
-	Tcl_AddErrorInfo(interp, "end of assembly code");
-    }
-    Tcl_DecrRefCount(lineNo);
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * DupAssembleCodeInternalRep --
- *
- *	Part of the Tcl object type implementation for Tcl assembly language
- *	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 assembly source, and if it is to be used as a compiled
- *	expression, it will need to be reprocessed.
- *
- *	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,
- *	as we do for lists and dicts.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-DupAssembleCodeInternalRep(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *copyPtr)
-{
-    return;
-}
-
-/*
- *-----------------------------------------------------------------------------
- *
- * FreeAssembleCodeInternalRep --
- *
- *	Part of the Tcl object type implementation for Tcl expression
- *	bytecode. Frees the storage allocated to hold the internal rep, unless
- *	ref counts indicate bytecode execution is still in progress.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	May free allocated memory. Leaves objPtr untyped.
- *
- *-----------------------------------------------------------------------------
- */
-
-static void
-FreeAssembleCodeInternalRep(
-    Tcl_Obj *objPtr)
-{
-    ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
-
-    codePtr->refCount--;
-    if (codePtr->refCount <= 0) {
-	TclCleanupByteCode(codePtr);
-    }
-    objPtr->typePtr = NULL;
-    objPtr->internalRep.otherValuePtr = NULL;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index 14804e4..98087c5 100644
--- a/generic/tclAsync.c
+++ b/generic/tclAsync.c
@@ -1,78 +1,91 @@
-/*
+/* 
  * 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.
+     * 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.
      */
-    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 */
+
+    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 */
+
 } 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.
@@ -81,7 +94,7 @@ static Tcl_ThreadDataKey dataKey;
  */
 
 void
-TclFinalizeAsync(void)
+TclFinalizeAsync()
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -96,12 +109,12 @@ TclFinalizeAsync(void)
  * 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.
@@ -110,15 +123,15 @@ TclFinalizeAsync(void)
  */
 
 Tcl_AsyncHandler
-Tcl_AsyncCreate(
-    Tcl_AsyncProc *proc,	/* Procedure to call when handler is
-				 * invoked. */
-    ClientData clientData)	/* Argument to pass to handler. */
+Tcl_AsyncCreate(proc, clientData)
+    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);
 
-    asyncPtr = ckalloc(sizeof(AsyncHandler));
+    asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
     asyncPtr->ready = 0;
     asyncPtr->nextPtr = NULL;
     asyncPtr->proc = proc;
@@ -142,10 +155,10 @@ Tcl_AsyncCreate(
  *
  * 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.
@@ -157,8 +170,8 @@ Tcl_AsyncCreate(
  */
 
 void
-Tcl_AsyncMark(
-    Tcl_AsyncHandler async)		/* Token for handler. */
+Tcl_AsyncMark(async)
+    Tcl_AsyncHandler async;		/* Token for handler. */
 {
     AsyncHandler *token = (AsyncHandler *) async;
 
@@ -176,12 +189,13 @@ Tcl_AsyncMark(
  *
  * 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.
@@ -190,13 +204,14 @@ Tcl_AsyncMark(
  */
 
 int
-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. */
+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. */
 {
     AsyncHandler *asyncPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -214,12 +229,13 @@ Tcl_AsyncInvoke(
     }
 
     /*
-     * 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.
      */
 
@@ -235,7 +251,7 @@ Tcl_AsyncInvoke(
 	}
 	asyncPtr->ready = 0;
 	Tcl_MutexUnlock(&tsdPtr->asyncMutex);
-	code = asyncPtr->proc(asyncPtr->clientData, interp, code);
+	code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
 	Tcl_MutexLock(&tsdPtr->asyncMutex);
     }
     tsdPtr->asyncActive = 0;
@@ -248,8 +264,8 @@ Tcl_AsyncInvoke(
  *
  * 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.
@@ -260,7 +276,7 @@ Tcl_AsyncInvoke(
  *	Failure to locate the handler in current thread private list
  *	of async handlers will result in panic; exception: the list
  *	is already empty (potential trouble?).
- *	Consequently, threads should create and delete handlers
+ *	Consequently, threads should create and delete handlers 
  *	themselves.  I.e. a handler created by one should not be
  *	deleted by some other thread.
  *
@@ -268,8 +284,8 @@ Tcl_AsyncInvoke(
  */
 
 void
-Tcl_AsyncDelete(
-    Tcl_AsyncHandler async)		/* Token for handler to delete. */
+Tcl_AsyncDelete(async)
+    Tcl_AsyncHandler async;		/* Token for handler to delete. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     AsyncHandler *asyncPtr = (AsyncHandler *) async;
@@ -280,7 +296,7 @@ Tcl_AsyncDelete(
      */
 
     if (asyncPtr->originThrdId != Tcl_GetCurrentThread()) {
-	Tcl_Panic("Tcl_AsyncDelete: async handler deleted by the wrong thread");
+	panic("Tcl_AsyncDelete: async handler deleted by the wrong thread");
     }
 
     /*
@@ -298,7 +314,7 @@ Tcl_AsyncDelete(
 	    thisPtr = thisPtr->nextPtr;
 	}
 	if (thisPtr == NULL) {
-	    Tcl_Panic("Tcl_AsyncDelete: cannot find async handler");
+	    panic("Tcl_AsyncDelete: cannot find async handler");
 	}
 	if (asyncPtr == tsdPtr->firstHandler) {
 	    tsdPtr->firstHandler = asyncPtr->nextPtr;
@@ -310,7 +326,7 @@ Tcl_AsyncDelete(
 	}
     }
     Tcl_MutexUnlock(&tsdPtr->asyncMutex);
-    ckfree(asyncPtr);
+    ckfree((char *) asyncPtr);
 }
 
 /*
@@ -318,13 +334,13 @@ Tcl_AsyncDelete(
  *
  * 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.
@@ -333,23 +349,8 @@ Tcl_AsyncDelete(
  */
 
 int
-Tcl_AsyncReady(void)
+Tcl_AsyncReady()
 {
     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 e09ea1e..c738916 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1,435 +1,280 @@
-/*
+/* 
  * 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.
  * 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>
- * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
- * Copyright (c) 2008 Miguel Sofer <msofer@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 "tclOOInt.h"
 #include "tclCompile.h"
-#include "tommath.h"
-#include <math.h>
-
-#if NRE_ENABLE_ASSERTS
-#include <assert.h>
+#ifndef TCL_GENERIC_ONLY
+#   include "tclPort.h"
 #endif
 
-#define INTERP_STACK_INITIAL_SIZE 2000
-#define CORO_STACK_INITIAL_SIZE    200
-
 /*
- * Determine whether we're using IEEE floating point
+ * Static procedures in this file:
  */
 
-#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
+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));
 #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;
-
-/*
- * This is the script cancellation struct and hash table. The hash table is
- * used to keep track of the information necessary to process script
- * cancellation requests, including the original interp, asynchronous handler
- * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments
- * passed to Tcl_CancelEval on a per-interp basis. The cancelLock mutex is
- * used for protecting calls to Tcl_CancelEval as well as protecting access to
- * the hash table below.
- */
-
-typedef struct {
-    Tcl_Interp *interp;		/* Interp this struct belongs to. */
-    Tcl_AsyncHandler async;	/* Async handler token for script
-				 * cancellation. */
-    char *result;		/* The script cancellation result or NULL for
-				 * a default result. */
-    int length;			/* Length of the above error message. */
-    ClientData clientData;	/* Ignored */
-    int flags;			/* Additional flags */
-} CancelInfo;
-static Tcl_HashTable cancelTable;
-static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
-TCL_DECLARE_MUTEX(cancelLock)
-
-/*
- * Declarations for managing contexts for non-recursive coroutines. Contexts
- * are used to save the evaluation state between NR calls to each coro.
- */
-
-static const CorContext NULL_CONTEXT = {NULL, NULL, NULL, NULL};
-
-#define SAVE_CONTEXT(context)				\
-    (context).framePtr = iPtr->framePtr;		\
-    (context).varFramePtr = iPtr->varFramePtr;		\
-    (context).cmdFramePtr = iPtr->cmdFramePtr;		\
-    (context).lineLABCPtr = iPtr->lineLABCPtr
-
-#define RESTORE_CONTEXT(context)			\
-    iPtr->framePtr = (context).framePtr;		\
-    iPtr->varFramePtr = (context).varFramePtr;		\
-    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
-    iPtr->lineLABCPtr = (context).lineLABCPtr
-
-/*
- * Static functions in this file:
- */
-
-static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
-			    const char *oldName, const char *newName,
-			    int flags);
-static int		CancelEvalProc(ClientData clientData,
-			    Tcl_Interp *interp, int code);
-static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
-static void		DeleteCoroutine(ClientData clientData);
-static void		DeleteInterpProc(Tcl_Interp *interp);
-static void		DeleteOpCmdClientData(ClientData clientData);
 #ifdef USE_DTRACE
-static Tcl_ObjCmdProc	DTraceObjCmd;
-static Tcl_NRPostProc	DTraceCmdReturn;
-#else
-#   define DTraceCmdReturn	NULL
-#endif /* USE_DTRACE */
-static Tcl_ObjCmdProc	ExprAbsFunc;
-static Tcl_ObjCmdProc	ExprBinaryFunc;
-static Tcl_ObjCmdProc	ExprBoolFunc;
-static Tcl_ObjCmdProc	ExprCeilFunc;
-static Tcl_ObjCmdProc	ExprDoubleFunc;
-static Tcl_ObjCmdProc	ExprEntierFunc;
-static Tcl_ObjCmdProc	ExprFloorFunc;
-static Tcl_ObjCmdProc	ExprIntFunc;
-static Tcl_ObjCmdProc	ExprIsqrtFunc;
-static Tcl_ObjCmdProc	ExprRandFunc;
-static Tcl_ObjCmdProc	ExprRoundFunc;
-static Tcl_ObjCmdProc	ExprSqrtFunc;
-static Tcl_ObjCmdProc	ExprSrandFunc;
-static Tcl_ObjCmdProc	ExprUnaryFunc;
-static Tcl_ObjCmdProc	ExprWideFunc;
-static Tcl_Obj *	GetCommandSource(Interp *iPtr, int objc,
-			    Tcl_Obj *const objv[], int lookup);
-static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
-			    int actual, Tcl_Obj *const *objv);
-static Tcl_NRPostProc	NRCoroutineActivateCallback;
-static Tcl_NRPostProc	NRCoroutineCallerCallback;
-static Tcl_NRPostProc	NRCoroutineExitCallback;
-static Tcl_NRPostProc	NRRunObjProc;
-static Tcl_NRPostProc	NRTailcallEval;
-static Tcl_ObjCmdProc	OldMathFuncProc;
-static void		OldMathFuncDeleteProc(ClientData clientData);
-static void		ProcessUnexpectedResult(Tcl_Interp *interp,
-			    int returnCode);
-static int		RewindCoroutine(CoroutineData *corPtr, int result);
-static void		TEOV_SwitchVarFrame(Tcl_Interp *interp);
-static void		TEOV_PushExceptionHandlers(Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[], int flags);
-static inline Command *	TEOV_LookupCmdFromObj(Tcl_Interp *interp,
-			    Tcl_Obj *namePtr, Namespace *lookupNsPtr);
-static int		TEOV_NotFound(Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
-static int		TEOV_RunEnterTraces(Tcl_Interp *interp,
-			    Command **cmdPtrPtr, int objc,
-			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
-static Tcl_NRPostProc	RewindCoroutineCallback;
-static Tcl_NRPostProc	TailcallCleanup;
-static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
-static Tcl_NRPostProc	TEOEx_ListCallback;
-static Tcl_NRPostProc	TEOV_Error;
-static Tcl_NRPostProc	TEOV_Exception;
-static Tcl_NRPostProc	TEOV_NotFoundCallback;
-static Tcl_NRPostProc	TEOV_RestoreVarFrame;
-static Tcl_NRPostProc	TEOV_RunLeaveTraces;
-static Tcl_NRPostProc	YieldToCallback;
-
-static void	        ClearTailcall(Tcl_Interp *interp,
-			    struct NRE_callback *tailcallPtr);
-static Tcl_ObjCmdProc NRCoroInjectObjCmd;
-
-MODULE_SCOPE const TclStubs tclStubs;
-
-/*
- * Magical counts for the number of arguments accepted by a coroutine command
- * after particular kinds of [yield].
- */
+static int	DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
+		    Tcl_Obj *CONST objv[]);
+#endif
 
-#define CORO_ACTIVATE_YIELD    PTR2INT(NULL)
-#define CORO_ACTIVATE_YIELDM   PTR2INT(NULL)+1
+extern TclStubs tclStubs;
 
-#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL     (-1)
-#define COROUTINE_ARGUMENTS_ARBITRARY           (-2)
-
 /*
- * The following structure define the commands in the Tcl core.
+ * The following structure defines the commands in the Tcl core.
  */
 
 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. */
-    Tcl_ObjCmdProc *nreProc;	/* NR-based function for 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_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. */
 } CmdInfo;
 
 /*
- * The built-in commands, and the functions that implement them:
- */
-
-static const CmdInfo builtInCmds[] = {
-    /*
-     * Commands in the generic core.
-     */
-
-    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	1},
-    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	1},
-    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	1},
-#ifndef EXCLUDE_OBSOLETE_COMMANDS
-    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	1},
-#endif
-    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	1},
-    {"concat",		Tcl_ConcatObjCmd,	NULL,			NULL,	1},
-    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	1},
-    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	1},
-    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	1},
-    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	1},
-    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	1},
-    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	1},
-    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	1},
-    {"format",		Tcl_FormatObjCmd,	NULL,			NULL,	1},
-    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	1},
-    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	1},
-    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	1},
-    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	1},
-    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	1},
-    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	1},
-    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	1},
-    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	1},
-    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	1},
-    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	1},
-    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	1},
-    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	1},
-    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	1},
-    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	1},
-    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	1},
-    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	1},
-    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	1},
-    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	1},
-    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	1},
-    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	1},
-    {"regsub",		Tcl_RegsubObjCmd,	NULL,			NULL,	1},
-    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	1},
-    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	1},
-    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	1},
-    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	1},
-    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	1},
-    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	1},
-    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, 1},
-    {"tailcall",	NULL,			NULL,			TclNRTailcallObjCmd,	1},
-    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	1},
-    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	1},
-    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	1},
-    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	1},
-    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
-    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	1},
-    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	1},
-    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	1},
-    {"yield",		NULL,			NULL,			TclNRYieldObjCmd,	1},
-    {"yieldto",		NULL,			NULL,			TclNRYieldToObjCmd,	1},
-
-    /*
-     * Commands in the OS-interface. Note that many of these are unsafe.
-     */
-
-    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	1},
-    {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},
-    {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	1},
-    {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	1},
-    {"encoding",	Tcl_EncodingObjCmd,	NULL,			NULL,	0},
-    {"exec",		Tcl_ExecObjCmd,		NULL,			NULL,	0},
-    {"exit",		Tcl_ExitObjCmd,		NULL,			NULL,	0},
-    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	1},
-    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			NULL,	0},
-    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			NULL,	1},
-    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			NULL,	1},
-    {"flush",		Tcl_FlushObjCmd,	NULL,			NULL,	1},
-    {"gets",		Tcl_GetsObjCmd,		NULL,			NULL,	1},
-    {"glob",		Tcl_GlobObjCmd,		NULL,			NULL,	0},
-    {"load",		Tcl_LoadObjCmd,		NULL,			NULL,	0},
-    {"open",		Tcl_OpenObjCmd,		NULL,			NULL,	0},
-    {"pid",		Tcl_PidObjCmd,		NULL,			NULL,	1},
-    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL,	1},
-    {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
-    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	1},
-    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	1},
-    {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
-    {"source",		Tcl_SourceObjCmd,	NULL,			TclNRSourceObjCmd,	0},
-    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	1},
-    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	1},
-    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
-    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	1},
-    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	1},
-    {NULL,		NULL,			NULL,			NULL,	0}
-};
-
-/*
- * Math functions. All are safe.
+ * The built-in commands, and the procedures that implement them:
  */
 
-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 }
+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},
+    
+#ifdef MAC_TCL
+    {"beep",		(Tcl_CmdProc *) NULL,	Tcl_BeepObjCmd,
+        (CompileProc *) NULL,		0},
+    {"echo",		Tcl_EchoCmd,		(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0},
+    {"ls",		(Tcl_CmdProc *) NULL, 	Tcl_LsObjCmd,
+        (CompileProc *) NULL,		0},
+    {"resource",	(Tcl_CmdProc *) NULL,	Tcl_ResourceObjCmd,
+        (CompileProc *) NULL,		1},
+    {"source",		(Tcl_CmdProc *) NULL,	Tcl_MacSourceObjCmd,
+        (CompileProc *) NULL,		0},
+#else
+    {"exec",		(Tcl_CmdProc *) NULL,	Tcl_ExecObjCmd,
+        (CompileProc *) NULL,		0},
+    {"source",		(Tcl_CmdProc *) NULL,	Tcl_SourceObjCmd,
+        (CompileProc *) NULL,		0},
+#endif /* MAC_TCL */
+    
+#endif /* TCL_GENERIC_ONLY */
+    {NULL,		(Tcl_CmdProc *) NULL,	(Tcl_ObjCmdProc *) NULL,
+        (CompileProc *) NULL,		0}
 };
 
 /*
- * 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}
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeEvaluation --
- *
- *	Finalizes the script cancellation hash table.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
+ * The following structure holds the client data for string-based
+ * trace procs
  */
 
-void
-TclFinalizeEvaluation(void)
-{
-    Tcl_MutexLock(&cancelLock);
-    if (cancelTableInitialized == 1) {
-	Tcl_DeleteHashTable(&cancelTable);
-	cancelTableInitialized = 0;
-    }
-    Tcl_MutexUnlock(&cancelLock);
-}
+typedef struct StringTraceData {
+    ClientData clientData;	/* Client data from Tcl_CreateTrace */
+    Tcl_CmdTraceProc* proc;	/* Trace procedure from Tcl_CreateTrace */
+} StringTraceData;
 
 /*
  *----------------------------------------------------------------------
@@ -439,29 +284,28 @@ TclFinalizeEvaluation(void)
  *	Create a new TCL command interpreter.
  *
  * Results:
- *	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.
+ *	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.
  *
  * 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(void)
+Tcl_CreateInterp()
 {
     Interp *iPtr;
     Tcl_Interp *interp;
     Command *cmdPtr;
-    const BuiltinFuncDef *builtinFuncPtr;
-    const OpCmdInfo *opcmdInfoPtr;
-    const CmdInfo *cmdInfoPtr;
-    Tcl_Namespace *mathfuncNSPtr, *mathopNSPtr;
+    BuiltinFunc *builtinFuncPtr;
+    MathFunc *mathFuncPtr;
     Tcl_HashEntry *hPtr;
-    int isNew;
-    CancelInfo *cancelInfo;
+    CONST CmdInfo *cmdInfoPtr;
+    int i;
     union {
 	char c[sizeof(short)];
 	short s;
@@ -469,96 +313,65 @@ Tcl_CreateInterp(void)
 #ifdef TCL_COMPILE_STATS
     ByteCodeStats *statsPtr;
 #endif /* TCL_COMPILE_STATS */
-    char mathFuncName[32];
-    CallFrame *framePtr;
-    int result;
 
-    TclInitSubsystems();
+    TclInitSubsystems(NULL);
 
     /*
-     * 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*/
-	Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
-    }
-
-    if (cancelTableInitialized == 0) {
-	Tcl_MutexLock(&cancelLock);
-	if (cancelTableInitialized == 0) {
-	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
-	    cancelTableInitialized = 1;
-	}
-	Tcl_MutexUnlock(&cancelLock);
+	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 = ckalloc(sizeof(Interp));
+    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;
+    iPtr->handle		= TclHandleCreate(iPtr);
+    iPtr->globalNsPtr		= NULL;
+    iPtr->hiddenCmdTablePtr	= NULL;
+    iPtr->interpInfo		= NULL;
+    Tcl_InitHashTable(&iPtr->mathFuncTable, TCL_STRING_KEYS);
 
     iPtr->numLevels = 0;
     iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
-    iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
-    iPtr->varFramePtr = NULL;	/* Initialise as soon as :: is available */
+    iPtr->framePtr = NULL;
+    iPtr->varFramePtr = NULL;
 
+#ifdef TCL_TIP280
     /*
-     * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
-     * structures.
+     * TIP #280 - Initialize the arrays used to extend the ByteCode and
+     * Proc structures.
      */
-
-    iPtr->cmdFramePtr = NULL;
-    iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable));
-    iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable));
-    iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable));
-    iPtr->lineLABCPtr = 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->returnOpts = NULL;
+    iPtr->returnCode = TCL_OK;
     iPtr->errorInfo = NULL;
-    TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo");
-    Tcl_IncrRefCount(iPtr->eiVar);
-    iPtr->errorStack = Tcl_NewListObj(0, NULL);
-    Tcl_IncrRefCount(iPtr->errorStack);
-    iPtr->resetErrorStack = 1;
-    TclNewLiteralStringObj(iPtr->upLiteral,"UP");
-    Tcl_IncrRefCount(iPtr->upLiteral);
-    TclNewLiteralStringObj(iPtr->callLiteral,"CALL");
-    Tcl_IncrRefCount(iPtr->callLiteral);
-    TclNewLiteralStringObj(iPtr->innerLiteral,"INNER");
-    Tcl_IncrRefCount(iPtr->innerLiteral);
-    iPtr->innerContext = Tcl_NewListObj(0, NULL);
-    Tcl_IncrRefCount(iPtr->innerContext);
     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;
@@ -566,16 +379,15 @@ Tcl_CreateInterp(void)
 
     Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
     iPtr->packageUnknown = NULL;
-
+#ifdef TCL_TIP268
     /* TIP #268 */
-    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
-	iPtr->packagePrefer = PKG_PREFER_STABLE;
-    } else {
-	iPtr->packagePrefer = PKG_PREFER_LATEST;
-    }
-
+    iPtr->packagePrefer = (getenv ("TCL_PKG_PREFER_LATEST") == NULL ? 
+			   PKG_PREFER_STABLE   :
+			   PKG_PREFER_LATEST);
+#endif
     iPtr->cmdCount = 0;
-    TclInitLiteralTable(&iPtr->literalTable);
+    iPtr->termOffset = 0;
+    TclInitLiteralTable(&(iPtr->literalTable));
     iPtr->compileEpoch = 0;
     iPtr->compiledProcPtr = NULL;
     iPtr->resolverPtr = NULL;
@@ -586,90 +398,28 @@ Tcl_CreateInterp(void)
     iPtr->tracesForbiddingInline = 0;
     iPtr->activeCmdTracePtr = NULL;
     iPtr->activeInterpTracePtr = NULL;
-    iPtr->assocData = NULL;
-    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
-    iPtr->emptyObjPtr = Tcl_NewObj();
-				/* Another empty object. */
+    iPtr->assocData = (Tcl_HashTable *) 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();
 
-    /* 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 = NULL;	/* force creation of global ns below */
     iPtr->globalNsPtr = (Namespace *) Tcl_CreateNamespace(interp, "",
-	    NULL, NULL);
+	    (ClientData) NULL, (Tcl_NamespaceDeleteProc *) NULL);
     if (iPtr->globalNsPtr == NULL) {
-	Tcl_Panic("Tcl_CreateInterp: can't create global namespace");
+        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 = 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"
      * variable).
      */
 
-    iPtr->execEnvPtr = TclCreateExecEnv(interp, INTERP_STACK_INITIAL_SIZE);
-
-    /*
-     * TIP #219, Tcl Channel Reflection API support.
-     */
-
-    iPtr->chanMsg = NULL;
-
-    /*
-     * TIP #285, Script cancellation support.
-     */
-
-    iPtr->asyncCancelMsg = Tcl_NewObj();
-
-    cancelInfo = ckalloc(sizeof(CancelInfo));
-    cancelInfo->interp = interp;
-
-    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
-    cancelInfo->async = iPtr->asyncCancel;
-    cancelInfo->result = NULL;
-    cancelInfo->length = 0;
-
-    Tcl_MutexLock(&cancelLock);
-    hPtr = Tcl_CreateHashEntry(&cancelTable, iPtr, &isNew);
-    Tcl_SetHashValue(hPtr, cancelInfo);
-    Tcl_MutexUnlock(&cancelLock);
+    iPtr->execEnvPtr = TclCreateExecEnv(interp);
 
     /*
      * Initialize the compilation and execution statistics kept for this
@@ -677,32 +427,35 @@ Tcl_CreateInterp(void)
      */
 
 #ifdef TCL_COMPILE_STATS
-    statsPtr = &iPtr->stats;
+    statsPtr = &(iPtr->stats);
     statsPtr->numExecutions = 0;
     statsPtr->numCompilations = 0;
     statsPtr->numByteCodesFreed = 0;
-    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;
-    memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
-    memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount));
-    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;
-    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.
@@ -710,130 +463,61 @@ Tcl_CreateInterp(void)
 
     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. Note that the thread's alloc
-     * cache was already initialised by the call to alloc the interp struct.
-     */
-
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-    iPtr->allocCache = TclpGetAllocCache();
-#else
-    iPtr->allocCache = NULL;
-#endif
-    iPtr->pendingObjDataPtr = NULL;
-    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
-    iPtr->deferredCallbacks = NULL;
-
+    
     /*
      * 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 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++) {
-	if ((cmdInfoPtr->objProc == NULL)
-		&& (cmdInfoPtr->compileProc == NULL)
-		&& (cmdInfoPtr->nreProc == NULL)) {
-	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
+     * 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_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");
 	}
-
+	
 	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
-		cmdInfoPtr->name, &isNew);
-	if (isNew) {
-	    cmdPtr = ckalloc(sizeof(Command));
+	        cmdInfoPtr->name, &new);
+	if (new) {
+	    cmdPtr = (Command *) ckalloc(sizeof(Command));
 	    cmdPtr->hPtr = hPtr;
 	    cmdPtr->nsPtr = iPtr->globalNsPtr;
 	    cmdPtr->refCount = 1;
 	    cmdPtr->cmdEpoch = 0;
 	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
-	    cmdPtr->proc = TclInvokeObjectCommand;
-	    cmdPtr->clientData = cmdPtr;
-	    cmdPtr->objProc = cmdInfoPtr->objProc;
-	    cmdPtr->objClientData = NULL;
+	    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->deleteProc = NULL;
-	    cmdPtr->deleteData = NULL;
+	    cmdPtr->deleteData = (ClientData) NULL;
 	    cmdPtr->flags = 0;
 	    cmdPtr->importRefPtr = NULL;
 	    cmdPtr->tracePtr = NULL;
-	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
 	    Tcl_SetHashValue(hPtr, cmdPtr);
 	}
     }
 
-    /*
-     * Create the "array", "binary", "chan", "dict", "file", "info",
-     * "namespace" and "string" ensembles. Note that all these commands (and
-     * their subcommands that are not present in the global namespace) are
-     * wholly safe *except* for "file".
-     */
-
-    TclInitArrayCmd(interp);
-    TclInitBinaryCmd(interp);
-    TclInitChanCmd(interp);
-    TclInitDictCmd(interp);
-    TclInitFileCmd(interp);
-    TclInitInfoCmd(interp);
-    TclInitNamespaceCmd(interp);
-    TclInitStringCmd(interp);
-    TclInitPrefixCmd(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 unsupported commands for debugging bytecode and objects.
-     */
-
-    Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
-	    Tcl_DisassembleObjCmd, NULL, NULL);
-    Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
-	    Tcl_RepresentationCmd, NULL, NULL);
-
-    /* Adding the bytecode assembler command */
-    cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
-            "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
-            TclNRAssembleObjCmd, NULL, NULL);
-    cmdPtr->compileProc = &TclCompileAssembleCmd;
-
-    Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
-	    NRCoroInjectObjCmd, NULL, NULL);
-
 #ifdef USE_DTRACE
     /*
      * Register the tcl::dtrace command.
@@ -846,60 +530,57 @@ Tcl_CreateInterp(void)
      * Register the builtin math functions.
      */
 
-    mathfuncNSPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
-    if (mathfuncNSPtr == NULL) {
-	Tcl_Panic("Can't create math function namespace");
-    }
-#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
-    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
-    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
+    i = 0;
+    for (builtinFuncPtr = tclBuiltinFuncTable;  builtinFuncPtr->name != NULL;
 	    builtinFuncPtr++) {
-	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);
-    if (mathopNSPtr == NULL) {
-	Tcl_Panic("can't create math operator namespace");
-    }
-    Tcl_Export(interp, mathopNSPtr, "*", 1);
-#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
-    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
-    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
-	TclOpCmdClientData *occdPtr = 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;
+	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;
 	}
+	mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
+	mathFuncPtr->builtinFuncIndex = i;
+	i++;
     }
+    iPtr->flags |= EXPR_INITIALIZED;
 
     /*
      * Do Multiple/Safe Interps Tcl init stuff
      */
 
     TclInterpInit(interp);
-    TclSetupEnv(interp);
 
     /*
-     * TIP #59: Make embedded configuration information available.
+     * 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);
      */
 
-    TclInitEmbeddedConfigurationInformation(interp);
+#ifndef TCL_GENERIC_ONLY
+    TclSetupEnv(interp);
+#endif
 
     /*
      * Compute the byte order of this machine.
@@ -913,77 +594,62 @@ Tcl_CreateInterp(void)
     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", NULL,
+    Tcl_TraceVar2(interp, "tcl_precision", (char *) NULL,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    TclPrecTraceProc, NULL);
+	    TclPrecTraceProc, (ClientData) 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: Full patchlevel instead of just major.minor
+     * TIP#268: Expose information about its status,
+     *          for runtime switches in the core library
+     *          and tests.
      */
 
-    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
-
-    if (TclTommath_Init(interp) != TCL_OK) {
-	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
-    }
-
-    if (TclOOInit(interp) != TCL_OK) {
-	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
-    }
-
-    /*
-     * Only build in zlib support if we've successfully detected a library to
-     * compile and link against.
-     */
+    Tcl_PkgProvideEx(interp, "Tcl", TCL_VERSION, (ClientData) &tclStubs);
 
-#ifdef HAVE_ZLIB
-    if (TclZlibInit(interp) != TCL_OK) {
-	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
-    }
+#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);
 
-    TOP_CB(iPtr) = NULL;
     return interp;
 }
-
-static void
-DeleteOpCmdClientData(
-    ClientData clientData)
-{
-    TclOpCmdClientData *occdPtr = clientData;
-
-    ckfree(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.
@@ -995,20 +661,19 @@ DeleteOpCmdClientData(
  */
 
 int
-TclHideUnsafeCommands(
-    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
+TclHideUnsafeCommands(interp)
+    Tcl_Interp *interp;		/* Hide commands in this interpreter. */
 {
-    register const CmdInfo *cmdInfoPtr;
+    register CONST CmdInfo *cmdInfoPtr;
 
-    if (interp == NULL) {
-	return TCL_ERROR;
+    if (interp == (Tcl_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);
+        }
     }
-    TclMakeFileCommandSafe(interp);     /* Ugh! */
     return TCL_OK;
 }
 
@@ -1017,46 +682,48 @@ TclHideUnsafeCommands(
  *
  * Tcl_CallWhenDeleted --
  *
- *	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
+ *	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
  *	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(
-    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. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
     static Tcl_ThreadDataKey assocDataCounterKey;
     int *assocDataCounterPtr =
 	    Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
-    int isNew;
+    int new;
     char buffer[32 + TCL_INTEGER_SPACE];
-    AssocData *dPtr = ckalloc(sizeof(AssocData));
+    AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
     Tcl_HashEntry *hPtr;
 
     sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
     (*assocDataCounterPtr)++;
 
-    if (iPtr->assocData == NULL) {
-	iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
     }
-    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &new);
     dPtr->proc = proc;
     dPtr->clientData = clientData;
     Tcl_SetHashValue(hPtr, dPtr);
@@ -1067,26 +734,27 @@ Tcl_CallWhenDeleted(
  *
  * Tcl_DontCallWhenDeleted --
  *
- *	Cancel the arrangement for a function to be called when a given
- *	interpreter is deleted.
+ *	Cancel the arrangement for a procedure 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(
-    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. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_HashTable *hTablePtr;
@@ -1095,17 +763,17 @@ Tcl_DontCallWhenDeleted(
     AssocData *dPtr;
 
     hTablePtr = iPtr->assocData;
-    if (hTablePtr == NULL) {
-	return;
+    if (hTablePtr == (Tcl_HashTable *) NULL) {
+        return;
     }
     for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
 	    hPtr = Tcl_NextHashEntry(&hSearch)) {
-	dPtr = Tcl_GetHashValue(hPtr);
-	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
-	    ckfree(dPtr);
-	    Tcl_DeleteHashEntry(hPtr);
-	    return;
-	}
+        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+        if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
+            ckfree((char *) dPtr);
+            Tcl_DeleteHashEntry(hPtr);
+            return;
+        }
     }
 }
 
@@ -1115,9 +783,9 @@ Tcl_DontCallWhenDeleted(
  * 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.
@@ -1129,27 +797,27 @@ Tcl_DontCallWhenDeleted(
  */
 
 void
-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. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
     AssocData *dPtr;
     Tcl_HashEntry *hPtr;
-    int isNew;
+    int new;
 
-    if (iPtr->assocData == NULL) {
-	iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+        Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
     }
-    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
-    if (isNew == 0) {
-	dPtr = Tcl_GetHashValue(hPtr);
+    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &new);
+    if (new == 0) {
+        dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
     } else {
-	dPtr = ckalloc(sizeof(AssocData));
+        dPtr = (AssocData *) ckalloc(sizeof(AssocData));
     }
     dPtr->proc = proc;
     dPtr->clientData = clientData;
@@ -1162,8 +830,8 @@ Tcl_SetAssocData(
  *
  * 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.
@@ -1175,26 +843,26 @@ Tcl_SetAssocData(
  */
 
 void
-Tcl_DeleteAssocData(
-    Tcl_Interp *interp,		/* Interpreter to associate with. */
-    const char *name)		/* Name of association. */
+Tcl_DeleteAssocData(interp, name)
+    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 == NULL) {
-	return;
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        return;
     }
     hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
-    if (hPtr == NULL) {
-	return;
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return;
     }
-    dPtr = Tcl_GetHashValue(hPtr);
+    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
     if (dPtr->proc != NULL) {
-	dPtr->proc(dPtr->clientData, interp);
+        (dPtr->proc) (dPtr->clientData, interp);
     }
-    ckfree(dPtr);
+    ckfree((char *) dPtr);
     Tcl_DeleteHashEntry(hPtr);
 }
 
@@ -1203,8 +871,8 @@ Tcl_DeleteAssocData(
  *
  * 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
@@ -1217,27 +885,26 @@ Tcl_DeleteAssocData(
  */
 
 ClientData
-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. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
     AssocData *dPtr;
     Tcl_HashEntry *hPtr;
 
-    if (iPtr->assocData == NULL) {
-	return NULL;
+    if (iPtr->assocData == (Tcl_HashTable *) NULL) {
+        return (ClientData) NULL;
     }
     hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
-    if (hPtr == NULL) {
-	return NULL;
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return (ClientData) NULL;
     }
-    dPtr = Tcl_GetHashValue(hPtr);
-    if (procPtr != NULL) {
-	*procPtr = dPtr->proc;
+    dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
+    if (procPtr != (Tcl_InterpDeleteProc **) NULL) {
+        *procPtr = dPtr->proc;
     }
     return dPtr->clientData;
 }
@@ -1247,8 +914,8 @@ Tcl_GetAssocData(
  *
  * 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.
@@ -1260,8 +927,8 @@ Tcl_GetAssocData(
  */
 
 int
-Tcl_InterpDeleted(
-    Tcl_Interp *interp)
+Tcl_InterpDeleted(interp)
+    Tcl_Interp *interp;
 {
     return (((Interp *) interp)->flags & DELETED) ? 1 : 0;
 }
@@ -1271,11 +938,11 @@ Tcl_InterpDeleted(
  *
  * 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
- *	function 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 procedure runs the currently registered deletion callbacks. 
  *
  * Results:
  *	None.
@@ -1290,9 +957,9 @@ Tcl_InterpDeleted(
  */
 
 void
-Tcl_DeleteInterp(
-    Tcl_Interp *interp)		/* Token for command interpreter (returned by
-				 * a previous call to Tcl_CreateInterp). */
+Tcl_DeleteInterp(interp)
+    Tcl_Interp *interp;		/* Token for command interpreter (returned
+				 * by a previous call to Tcl_CreateInterp). */
 {
     Interp *iPtr = (Interp *) interp;
 
@@ -1301,22 +968,21 @@ Tcl_DeleteInterp(
      */
 
     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(interp, (Tcl_FreeProc *) DeleteInterpProc);
+    Tcl_EventuallyFree((ClientData) interp,
+            (Tcl_FreeProc *) DeleteInterpProc);
 }
 
 /*
@@ -1324,204 +990,149 @@ Tcl_DeleteInterp(
  *
  * DeleteInterpProc --
  *
- *	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.
+ *	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.
  *
  * 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(
-    Tcl_Interp *interp)		/* Interpreter to delete. */
+DeleteInterpProc(interp)
+    Tcl_Interp *interp;			/* Interpreter to delete. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
     Tcl_HashTable *hTablePtr;
     ResolverScheme *resPtr, *nextResPtr;
-    int i;
 
     /*
-     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
-	 * unless we are exiting.
+     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
      */
-
-    if ((iPtr->numLevels > 0) && !TclInExit()) {
-	Tcl_Panic("DeleteInterpProc called with active evals");
+    
+    if (iPtr->numLevels > 0) {
+        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)) {
-	Tcl_Panic("DeleteInterpProc called on interpreter not marked deleted");
-    }
-
-    /*
-     * TIP #219, Tcl Channel Reflection API. Discard a leftover state.
-     */
-
-    if (iPtr->chanMsg != NULL) {
-	Tcl_DecrRefCount(iPtr->chanMsg);
-	iPtr->chanMsg = NULL;
-    }
-
-    /*
-     * TIP #285, Script cancellation support. Delete this interp from the
-     * global hash table of CancelInfo structs.
-     */
-
-    Tcl_MutexLock(&cancelLock);
-    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
-    if (hPtr != NULL) {
-	CancelInfo *cancelInfo = Tcl_GetHashValue(hPtr);
-
-	if (cancelInfo != NULL) {
-	    if (cancelInfo->result != NULL) {
-		ckfree(cancelInfo->result);
-	    }
-	    ckfree(cancelInfo);
-	}
-
-	Tcl_DeleteHashEntry(hPtr);
-    }
-
-    if (iPtr->asyncCancel != NULL) {
-	Tcl_AsyncDelete(iPtr->asyncCancel);
-	iPtr->asyncCancel = NULL;
+        panic("DeleteInterpProc called on interpreter not marked deleted");
     }
 
-    if (iPtr->asyncCancelMsg != NULL) {
-	Tcl_DecrRefCount(iPtr->asyncCancelMsg);
-	iPtr->asyncCancelMsg = NULL;
-    }
-    Tcl_MutexUnlock(&cancelLock);
-
-    /*
-     * 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);
+    TclHandleFree(iPtr->handle);
 
     /*
+     * 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.
-	 * Tcl_DeleteCommandFromToken will remove the entry from the
+	 * 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)) {
-	    Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr));
+	for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	    Tcl_DeleteCommandFromToken(interp,
+		    (Tcl_Command) Tcl_GetHashValue(hPtr));
 	}
 	Tcl_DeleteHashTable(hTablePtr);
-	ckfree(hTablePtr);
+	ckfree((char *) hTablePtr);
     }
+    /*
+     * Tear down the math function table.
+     */
+
+    for (hPtr = Tcl_FirstHashEntry(&iPtr->mathFuncTable, &search);
+	     hPtr != NULL;
+             hPtr = Tcl_NextHashEntry(&search)) {
+	ckfree((char *) Tcl_GetHashValue(hPtr));
+    }
+    Tcl_DeleteHashTable(&iPtr->mathFuncTable);
 
     /*
      * Invoke deletion callbacks; note that a callback can create new
      * callbacks, so we iterate.
      */
 
-    while (iPtr->assocData != NULL) {
+    while (iPtr->assocData != (Tcl_HashTable *) 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(dPtr);
-	}
-	Tcl_DeleteHashTable(hTablePtr);
-	ckfree(hTablePtr);
+	
+        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);
     }
 
     /*
-     * Pop the root frame pointer and finish deleting the global
-     * namespace. The order is important [Bug 1658572].
+     * Finish deleting the global namespace.
      */
-
-    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
-	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
-    }
-    Tcl_PopCallFrame(interp);
-    ckfree(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);
-    iPtr->result = NULL;
+    interp->result = NULL;
     Tcl_DecrRefCount(iPtr->objResultPtr);
     iPtr->objResultPtr = NULL;
-    Tcl_DecrRefCount(iPtr->ecVar);
-    if (iPtr->errorCode) {
-	Tcl_DecrRefCount(iPtr->errorCode);
-	iPtr->errorCode = NULL;
-    }
-    Tcl_DecrRefCount(iPtr->eiVar);
-    if (iPtr->errorInfo) {
-	Tcl_DecrRefCount(iPtr->errorInfo);
-	iPtr->errorInfo = NULL;
-    }
-    Tcl_DecrRefCount(iPtr->errorStack);
-    iPtr->errorStack = NULL;
-    Tcl_DecrRefCount(iPtr->upLiteral);
-    Tcl_DecrRefCount(iPtr->callLiteral);
-    Tcl_DecrRefCount(iPtr->innerLiteral);
-    Tcl_DecrRefCount(iPtr->innerContext);
-    if (iPtr->returnOpts) {
-	Tcl_DecrRefCount(iPtr->returnOpts);
+    if (iPtr->errorInfo != NULL) {
+	ckfree(iPtr->errorInfo);
+        iPtr->errorInfo = NULL;
+    }
+    if (iPtr->errorCode != NULL) {
+	ckfree(iPtr->errorCode);
+        iPtr->errorCode = NULL;
     }
     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);
@@ -1537,108 +1148,108 @@ DeleteInterpProc(
     while (resPtr) {
 	nextResPtr = resPtr->nextPtr;
 	ckfree(resPtr->name);
-	ckfree(resPtr);
-	resPtr = nextResPtr;
+	ckfree((char *) resPtr);
+        resPtr = nextResPtr;
     }
-
+    
     /*
      * Free up literal objects created for scripts compiled by the
      * interpreter.
      */
 
-    TclDeleteLiteralTable(interp, &iPtr->literalTable);
+    TclDeleteLiteralTable(interp, &(iPtr->literalTable));
 
-    /*
-     * TIP #280 - Release the arrays for ByteCode/Proc extension, and
-     * contents.
+#ifdef TCL_TIP280
+    /* TIP #280 - Release the arrays for ByteCode/Proc extension, and contents.
      */
+    {
+        Tcl_HashEntry *hPtr;
+	Tcl_HashSearch hSearch;
+	CmdFrame*      cfPtr;
+	ExtCmdLoc*     eclPtr;
+	int            i;
 
-    for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search);
-	    hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&search)) {
-	CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
-
-	if (cfPtr->type == TCL_LOCATION_SOURCE) {
-	    Tcl_DecrRefCount(cfPtr->data.eval.path);
-	}
-	ckfree(cfPtr->line);
-	ckfree(cfPtr);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(iPtr->linePBodyPtr);
-    ckfree(iPtr->linePBodyPtr);
-    iPtr->linePBodyPtr = NULL;
+	for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);
+	     hPtr != NULL;
+	     hPtr = Tcl_NextHashEntry(&hSearch)) {
 
-    /*
-     * See also tclCompile.c, TclCleanupByteCode
-     */
+	    cfPtr = (CmdFrame*) Tcl_GetHashValue (hPtr);
 
-    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
-	    hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&search)) {
-	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr);
+	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
+	        Tcl_DecrRefCount (cfPtr->data.eval.path);
+	    }
+	    ckfree ((char*) cfPtr->line);
+	    ckfree ((char*) cfPtr);
+	    Tcl_DeleteHashEntry (hPtr);
 
-	if (eclPtr->type == TCL_LOCATION_SOURCE) {
-	    Tcl_DecrRefCount(eclPtr->path);
-	}
-	for (i=0; i< eclPtr->nuloc; i++) {
-	    ckfree(eclPtr->loc[i].line);
 	}
+	Tcl_DeleteHashTable (iPtr->linePBodyPtr);
+	ckfree ((char*) iPtr->linePBodyPtr);
+	iPtr->linePBodyPtr = NULL;
 
-	if (eclPtr->loc != NULL) {
-	    ckfree(eclPtr->loc);
-	}
+	/* See also tclCompile.c, TclCleanupByteCode */
 
-	Tcl_DeleteHashTable(&eclPtr->litInfo);
+	for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch);
+	     hPtr != NULL;
+	     hPtr = Tcl_NextHashEntry(&hSearch)) {
 
-	ckfree(eclPtr);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(iPtr->lineBCPtr);
-    ckfree(iPtr->lineBCPtr);
-    iPtr->lineBCPtr = NULL;
+	    eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hPtr);
 
-    /*
-     * Location stack for uplevel/eval/... scripts which were passed through
-     * proc arguments. Actually we track all arguments as we do not and cannot
-     * know which arguments will be used as scripts and which will not.
-     */
+	    if (eclPtr->type == TCL_LOCATION_SOURCE) {
+	        Tcl_DecrRefCount (eclPtr->path);
+	    }
+	    for (i=0; i< eclPtr->nuloc; i++) {
+	        ckfree ((char*) eclPtr->loc[i].line);
+	    }
 
-    if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
-	/*
-	 * When the interp goes away we have nothing on the stack, so there
-	 * are no arguments, so this table has to be empty.
-	 */
+            if (eclPtr->loc != NULL) {
+		ckfree ((char*) eclPtr->loc);
+	    }
 
-	Tcl_Panic("Argument location tracking table not empty");
-    }
+	    Tcl_DeleteHashTable (&eclPtr->litInfo);
 
-    Tcl_DeleteHashTable(iPtr->lineLAPtr);
-    ckfree((char *) iPtr->lineLAPtr);
-    iPtr->lineLAPtr = NULL;
+	    ckfree ((char*) eclPtr);
+	    Tcl_DeleteHashEntry (hPtr);
+	}
+	Tcl_DeleteHashTable (iPtr->lineBCPtr);
+	ckfree((char*) iPtr->lineBCPtr);
+	iPtr->lineBCPtr = NULL;
 
-    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
 	/*
-	 * When the interp goes away we have nothing on the stack, so there
-	 * are no arguments, so this table has to be empty.
+	 * Location stack for uplevel/eval/... scripts which were passed
+	 * through proc arguments. Actually we track all arguments as we
+	 * don't, cannot know which arguments will be used as scripts and
+	 * which won't.
 	 */
 
-	Tcl_Panic("Argument location tracking table not empty");
-    }
+	if (iPtr->lineLAPtr->numEntries) {
+	    /*
+	     * When the interp goes away we have nothing on the stack, so
+	     * there are no arguments, so this table has to be empty.
+	     */
 
-    Tcl_DeleteHashTable(iPtr->lineLABCPtr);
-    ckfree(iPtr->lineLABCPtr);
-    iPtr->lineLABCPtr = NULL;
+	    Tcl_Panic ("Argument location tracking table not empty");
+	}
 
-    /*
-     * Squelch the tables of traces on variables and searches over arrays in
-     * the in the interpreter.
-     */
+	Tcl_DeleteHashTable (iPtr->lineLAPtr);
+	ckfree((char*) iPtr->lineLAPtr);
+	iPtr->lineLAPtr = NULL;
 
-    Tcl_DeleteHashTable(&iPtr->varTraces);
-    Tcl_DeleteHashTable(&iPtr->varSearches);
+	if (iPtr->lineLABCPtr->numEntries) {
+	    /*
+	     * When the interp goes away we have nothing on the stack, so
+	     * there are no arguments, so this table has to be empty.
+	     */
 
-    ckfree(iPtr);
+	    Tcl_Panic ("Argument location tracking table not empty");
+	}
+
+	Tcl_DeleteHashTable (iPtr->lineLABCPtr);
+	ckfree((char*) iPtr->lineLABCPtr);
+	iPtr->lineLABCPtr = NULL;
+    }
+#endif
+    ckfree((char *) iPtr);
 }
 
 /*
@@ -1646,78 +1257,79 @@ DeleteInterpProc(
  *
  * 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(
-    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(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. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_Command cmd;
     Command *cmdPtr;
     Tcl_HashTable *hiddenCmdTablePtr;
     Tcl_HashEntry *hPtr;
-    int isNew;
+    int new;
 
     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;
     }
 
     /*
      * 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_AppendResult(interp,
-		"cannot use namespace qualifiers in hidden command"
-		" token (rename)", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "cannot use namespace qualifiers in hidden command",
+		" token (rename)", (char *) 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, NULL,
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
 	    /*flags*/ TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
     if (cmd == (Tcl_Command) NULL) {
 	return TCL_ERROR;
@@ -1728,21 +1340,22 @@ Tcl_HideCommand(
      * Check that the command is really in global namespace
      */
 
-    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
-	Tcl_AppendResult(interp, "can only hide global namespace commands"
-		" (use rename then hide)", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL);
-	return TCL_ERROR;
+    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;
     }
-
+    
     /*
      * Initialize the hidden command table if necessary.
      */
 
     hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
     if (hiddenCmdTablePtr == NULL) {
-	hiddenCmdTablePtr = ckalloc(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;
     }
 
@@ -1751,19 +1364,20 @@ Tcl_HideCommand(
      * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
      * exists.
      */
-
-    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
-    if (!isNew) {
-	Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
-		"\" already exists", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
-	return TCL_ERROR;
+    
+    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &new);
+    if (!new) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "hidden command named \"", hiddenCmdToken, "\" already exists",
+                (char *) 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 until
-     * 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 untill the common parts are actually
+     * factorized out.
      */
 
     /*
@@ -1773,34 +1387,26 @@ Tcl_HideCommand(
      */
 
     if (cmdPtr->hPtr != NULL) {
-	Tcl_DeleteHashEntry(cmdPtr->hPtr);
-	cmdPtr->hPtr = NULL;
+        Tcl_DeleteHashEntry(cmdPtr->hPtr);
+        cmdPtr->hPtr = (Tcl_HashEntry *) NULL;
 	cmdPtr->cmdEpoch++;
     }
 
     /*
-     * 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.
+     * Now link the hash table entry with the command structure.
+     * We ensured above that the nsPtr was right.
      */
-
-    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, cmdPtr);
+    Tcl_SetHashValue(hPtr, (ClientData) cmdPtr);
 
     /*
-     * 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 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 (cmdPtr->compileProc != NULL) {
@@ -1814,12 +1420,12 @@ Tcl_HideCommand(
  *
  * 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.
@@ -1828,39 +1434,40 @@ Tcl_HideCommand(
  */
 
 int
-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. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
     Command *cmdPtr;
     Namespace *nsPtr;
     Tcl_HashEntry *hPtr;
     Tcl_HashTable *hiddenCmdTablePtr;
-    int isNew;
+    int new;
 
     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_AppendResult(interp, "cannot expose to a namespace "
-		"(use expose to toplevel, then rename)", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "can not expose to a namespace ",
+		"(use expose to toplevel, then rename)",
+                 (char *) NULL);
+        return TCL_ERROR;
     }
 
     /*
@@ -1872,104 +1479,82 @@ Tcl_ExposeCommand(
     if (hiddenCmdTablePtr != NULL) {
 	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
     }
-    if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
-		"\"", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
-                hiddenCmdToken, NULL);
-	return TCL_ERROR;
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown hidden command \"", hiddenCmdToken,
+                "\"", (char *) NULL);
+        return TCL_ERROR;
     }
-    cmdPtr = Tcl_GetHashValue(hPtr);
+    cmdPtr = (Command *) 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 Tcl_Panic
-	 * than 'nicely' erroring out ?
+    if ( cmdPtr->nsPtr != iPtr->globalNsPtr ) {
+	/* 
+	 * This case is theoritically impossible,
+	 * we might rather panic() than 'nicely' erroring out ?
 	 */
-
-	Tcl_AppendResult(interp,
-		"trying to expose a non-global command namespace command",
-		NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "trying to expose a non global command name space command",
+		(char *) 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, &isNew);
-    if (!isNew) {
-	Tcl_AppendResult(interp, "exposed command \"", cmdName,
-		"\" already exists", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL);
-	return TCL_ERROR;
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &new);
+    if (!new) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "exposed command \"", cmdName,
+                "\" already exists", (char *) NULL);
+        return TCL_ERROR;
     }
 
     /*
-     * Command resolvers (per-interp, per-namespace) might have resolved to a
-     * command for the given namespace scope with this command not being
-     * registered with the namespace's command table. During BC compilation,
-     * the so-resolved command turns into a CmdName literal. Without
-     * invalidating a possible CmdName literal here explicitly, such literals
-     * keep being reused while pointing to overhauled commands.
-     */
-
-    TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
-
-    /*
-     * 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, cmdPtr);
+    Tcl_SetHashValue(hPtr, (ClientData) 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 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
+     * 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
      * recompiled.
      */
 
@@ -1987,125 +1572,104 @@ Tcl_ExposeCommand(
  *	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(
-    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(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
 				 * qualifiers, the new command is put in the
-				 * 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. */
+				 * 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. */
 {
     Interp *iPtr = (Interp *) interp;
     ImportRef *oldRefPtr = NULL;
     Namespace *nsPtr, *dummy1, *dummy2;
     Command *cmdPtr, *refCmdPtr;
     Tcl_HashEntry *hPtr;
-    const char *tail;
-    int isNew;
+    CONST char *tail;
+    int new;
     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, NULL,
-		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
-	if ((nsPtr == NULL) || (tail == NULL)) {
+       TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+           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, &isNew);
-    if (!isNew) {
+    
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
 	/*
-	 * 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 = Tcl_GetHashValue(hPtr);
+	cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
 	oldRefPtr = cmdPtr->importRefPtr;
 	cmdPtr->importRefPtr = NULL;
 
 	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
-	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
-	if (!isNew) {
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+	if (!new) {
 	    /*
-	     * 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(Tcl_GetHashValue(hPtr));
+	     ckfree((char*) Tcl_GetHashValue(hPtr));
 	}
-    } else {
-	/*
-	 * Command resolvers (per-interp, per-namespace) might have resolved
-	 * to a command for the given namespace scope with this command not
-	 * being registered with the namespace's command table. During BC
-	 * compilation, the so-resolved command turns into a CmdName literal.
-	 * Without invalidating a possible CmdName literal here explicitly,
-	 * such literals keep being reused while pointing to overhauled
-	 * commands.
-	 */
-
-	TclInvalidateCmdLiteral(interp, tail, nsPtr);
-
-	/*
-	 * 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 = ckalloc(sizeof(Command));
+    cmdPtr = (Command *) ckalloc(sizeof(Command));
     Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
     cmdPtr->nsPtr = nsPtr;
     cmdPtr->refCount = 1;
     cmdPtr->cmdEpoch = 0;
-    cmdPtr->compileProc = NULL;
+    cmdPtr->compileProc = (CompileProc *) NULL;
     cmdPtr->objProc = TclInvokeStringCommand;
-    cmdPtr->objClientData = cmdPtr;
+    cmdPtr->objClientData = (ClientData) cmdPtr;
     cmdPtr->proc = proc;
     cmdPtr->clientData = clientData;
     cmdPtr->deleteProc = deleteProc;
@@ -2113,18 +1677,17 @@ Tcl_CreateCommand(
     cmdPtr->flags = 0;
     cmdPtr->importRefPtr = NULL;
     cmdPtr->tracePtr = NULL;
-    cmdPtr->nreProc = 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 = refCmdPtr->objClientData;
+	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
 	    dataPtr->realCmdPtr = cmdPtr;
 	    oldRefPtr = oldRefPtr->nextPtr;
 	}
@@ -2136,7 +1699,7 @@ Tcl_CreateCommand(
      * shadowed commands are found, invalidate all cached command references
      * in the affected namespaces.
      */
-
+    
     TclResetShadowedCmdRefs(interp, cmdPtr);
     return (Tcl_Command) cmdPtr;
 }
@@ -2149,70 +1712,70 @@ Tcl_CreateCommand(
  *	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(
-    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(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
 				 * qualifiers, the new command is put in the
-				 * specified namespace; otherwise it is put in
-				 * the global namespace. */
-    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
+				 * specified namespace; otherwise it is put
+				 * in the global namespace. */
+    Tcl_ObjCmdProc *proc;	/* Object-based procedure to associate with
 				 * name. */
-    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. */
+    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. */
 {
     Interp *iPtr = (Interp *) interp;
     ImportRef *oldRefPtr = NULL;
     Namespace *nsPtr, *dummy1, *dummy2;
     Command *cmdPtr, *refCmdPtr;
     Tcl_HashEntry *hPtr;
-    const char *tail;
-    int isNew;
+    CONST char *tail;
+    int new;
     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, NULL,
-		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
-	if ((nsPtr == NULL) || (tail == NULL)) {
+       TclGetNamespaceForQualName(interp, cmdName, (Namespace *) NULL,
+           CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
+       if ((nsPtr == NULL) || (tail == NULL)) {
 	    return (Tcl_Command) NULL;
 	}
     } else {
@@ -2220,107 +1783,85 @@ Tcl_CreateObjCommand(
 	tail = cmdName;
     }
 
-    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
-    TclInvalidateNsPath(nsPtr);
-    if (!isNew) {
-	cmdPtr = Tcl_GetHashValue(hPtr);
+    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+    if (!new) {
+	cmdPtr = (Command *) 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, &isNew);
-	if (!isNew) {
+	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &new);
+	if (!new) {
 	    /*
-	     * 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(Tcl_GetHashValue(hPtr));
+	     ckfree((char *) Tcl_GetHashValue(hPtr));
 	}
-    } else {
-	/*
-	 * Command resolvers (per-interp, per-namespace) might have resolved
-	 * to a command for the given namespace scope with this command not
-	 * being registered with the namespace's command table. During BC
-	 * compilation, the so-resolved command turns into a CmdName literal.
-	 * Without invalidating a possible CmdName literal here explicitly,
-	 * such literals keep being reused while pointing to overhauled
-	 * commands.
-	 */
-
-	TclInvalidateCmdLiteral(interp, tail, nsPtr);
-
-	/*
-	 * 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 = ckalloc(sizeof(Command));
+    cmdPtr = (Command *) ckalloc(sizeof(Command));
     Tcl_SetHashValue(hPtr, cmdPtr);
     cmdPtr->hPtr = hPtr;
     cmdPtr->nsPtr = nsPtr;
     cmdPtr->refCount = 1;
     cmdPtr->cmdEpoch = 0;
-    cmdPtr->compileProc = NULL;
+    cmdPtr->compileProc = (CompileProc *) NULL;
     cmdPtr->objProc = proc;
     cmdPtr->objClientData = clientData;
     cmdPtr->proc = TclInvokeObjectCommand;
-    cmdPtr->clientData = cmdPtr;
+    cmdPtr->clientData = (ClientData) cmdPtr;
     cmdPtr->deleteProc = deleteProc;
     cmdPtr->deleteData = clientData;
     cmdPtr->flags = 0;
     cmdPtr->importRefPtr = NULL;
     cmdPtr->tracePtr = NULL;
-    cmdPtr->nreProc = 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 = refCmdPtr->objClientData;
+	    dataPtr = (ImportedCmdData*)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;
 }
@@ -2331,10 +1872,10 @@ Tcl_CreateObjCommand(
  * TclInvokeStringCommand --
  *
  *	"Wrapper" Tcl_ObjCmdProc used to call an existing string-based
- *	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.
+ *	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.
  *
  * Results:
  *	A standard Tcl object result value.
@@ -2347,18 +1888,37 @@ Tcl_CreateObjCommand(
  */
 
 int
-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. */
-{
-    Command *cmdPtr = clientData;
-    int i, result;
-    const char **argv =
-	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
+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. */
+{
+    register Command *cmdPtr = (Command *) clientData;
+    register int i;
+    int result;
 
-    for (i = 0; i < objc; i++) {
+    /*
+     * 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 *));
+    }
+
+    for (i = 0;  i < objc;  i++) {
 	argv[i] = Tcl_GetString(objv[i]);
     }
     argv[objc] = 0;
@@ -2367,10 +1927,17 @@ TclInvokeStringCommand(
      * Invoke the command's string-based Tcl_CmdProc.
      */
 
-    result = cmdPtr->proc(cmdPtr->clientData, interp, objc, argv);
+    result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);
 
-    TclStackFree(interp, (void *) argv);
+    /*
+     * Free the argv array if malloc'ed storage was used.
+     */
+
+    if (argv != argStorage) {
+	ckfree((char *) argv);
+    }
     return result;
+#undef NUM_ARGS
 }
 
 /*
@@ -2379,10 +1946,10 @@ TclInvokeStringCommand(
  * TclInvokeObjectCommand --
  *
  *	"Wrapper" Tcl_CmdProc used to call an existing object-based
- *	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.
+ *	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.
  *
  * Results:
  *	A standard Tcl string result value.
@@ -2395,21 +1962,42 @@ TclInvokeStringCommand(
  */
 
 int
-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. */
+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. */
 {
-    Command *cmdPtr = clientData;
-    Tcl_Obj *objPtr;
-    int i, length, result;
-    Tcl_Obj **objv =
-	    TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));
+    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.
+     */
 
-    for (i = 0; i < argc; i++) {
+    if (argc > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc * sizeof(Tcl_Obj *)));
+    }
+
+    for (i = 0;  i < argc;  i++) {
 	length = strlen(argv[i]);
-	TclNewStringObj(objPtr, argv[i], length);
+	TclNewObj(objPtr);
+	TclInitStringRep(objPtr, argv[i], length);
 	Tcl_IncrRefCount(objPtr);
 	objv[i] = objPtr;
     }
@@ -2418,31 +2006,30 @@ TclInvokeObjectCommand(
      * Invoke the command's object-based Tcl_ObjCmdProc.
      */
 
-    if (cmdPtr->objProc != NULL) {
-	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
-    } else {
-	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
-		cmdPtr->objClientData, argc, objv);
-    }
+    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.
      */
 
-    (void) Tcl_GetStringResult(interp);
-
+    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	    TCL_VOLATILE);
+    
     /*
-     * 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++) {
+    for (i = 0;  i < argc;  i++) {
 	objPtr = objv[i];
 	Tcl_DecrRefCount(objPtr);
     }
-    TclStackFree(interp, objv);
+    if (objv != argStorage) {
+	ckfree((char *) objv);
+    }
     return result;
+#undef NUM_ARGS
 }
 
 /*
@@ -2450,65 +2037,65 @@ TclInvokeObjectCommand(
  *
  * 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(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    const char *oldName,	/* Existing command name. */
-    const char *newName)	/* New command name. */
+TclRenameCommand(interp, oldName, newName)
+    Tcl_Interp *interp;                 /* Current interpreter. */
+    char *oldName;                      /* Existing command name. */
+    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 isNew, result;
-    Tcl_Obj *oldFullName;
+    int new, 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, NULL, /*flags*/ 0);
+    cmd = Tcl_FindCommand(interp, oldName, (Tcl_Namespace *) NULL,
+	/*flags*/ 0);
     cmdPtr = (Command *) cmd;
     if (cmdPtr == NULL) {
-	Tcl_AppendResult(interp, "can't ",
-		((newName == NULL)||(*newName == '\0'))? "delete":"rename",
-		" \"", oldName, "\": command doesn't exist", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't ",
+                ((newName == NULL)||(*newName == '\0'))? "delete":"rename",
+                " \"", oldName, "\": command doesn't exist", (char *) 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;
@@ -2516,120 +2103,101 @@ TclRenameCommand(
     }
 
     /*
-     * 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, NULL,
-	    TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
+    TclGetNamespaceForQualName(interp, newName, (Namespace *) NULL,
+       CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);
 
     if ((newNsPtr == NULL) || (newTail == NULL)) {
-	Tcl_AppendResult(interp, "can't rename to \"", newName,
-		"\": bad command name", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		 "can't rename to \"", newName, "\": bad command name",
+    	    	 (char *) NULL);
 	result = TCL_ERROR;
 	goto done;
     }
     if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
-	Tcl_AppendResult(interp, "can't rename to \"", newName,
-		 "\": command already exists", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
-                "TARGET_EXISTS", NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		 "can't rename to \"", newName,
+		 "\": command already exists", (char *) 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, &isNew);
-    Tcl_SetHashValue(hPtr, cmdPtr);
+    hPtr = Tcl_CreateHashEntry(&newNsPtr->cmdTable, newTail, &new);
+    Tcl_SetHashValue(hPtr, (ClientData) 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;
     }
 
     /*
-     * 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);
-
-    /*
-     * Command resolvers (per-interp, per-namespace) might have resolved to a
-     * command for the given namespace scope with this command not being
-     * registered with the namespace's command table. During BC compilation,
-     * the so-resolved command turns into a CmdName literal. Without
-     * invalidating a possible CmdName literal here explicitly, such literals
-     * keep being reused while pointing to overhauled commands.
-     */
-
-    TclInvalidateCmdLiteral(interp, newTail, 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.
+     * 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 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!
+     * 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!
      */
 
-    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 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 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 (cmdPtr->compileProc != NULL) {
@@ -2637,15 +2205,14 @@ TclRenameCommand(
     }
 
     /*
-     * 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.
      */
-
-    TclCleanupCommandMacro(cmdPtr);
+    TclCleanupCommand(cmdPtr);
     result = TCL_OK;
 
-  done:
-    TclDecrRefCount(oldFullName);
+    done:
+    TclDecrRefCount( oldFullName );
     return result;
 }
 
@@ -2654,15 +2221,16 @@ TclRenameCommand(
  *
  * Tcl_SetCommandInfo --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -2671,17 +2239,20 @@ TclRenameCommand(
  */
 
 int
-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_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_Command cmd;
 
-    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
-    return Tcl_SetCommandInfoFromToken(cmd, infoPtr);
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+
+    return Tcl_SetCommandInfoFromToken( cmd, infoPtr );
+
 }
 
 /*
@@ -2689,15 +2260,16 @@ Tcl_SetCommandInfo(
  *
  * Tcl_SetCommandInfoFromToken --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -2706,32 +2278,28 @@ Tcl_SetCommandInfo(
  */
 
 int
-Tcl_SetCommandInfoFromToken(
-    Tcl_Command cmd,
-    const Tcl_CmdInfo *infoPtr)
+Tcl_SetCommandInfoFromToken( cmd, infoPtr )
+    Tcl_Command cmd;
+    CONST Tcl_CmdInfo* infoPtr;
 {
-    Command *cmdPtr;		/* Internal representation of the command */
+    Command* cmdPtr;		/* Internal representation of the command */
 
-    if (cmd == NULL) {
+    if (cmd == (Tcl_Command) NULL) {
 	return 0;
     }
 
     /*
      * The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
      */
-
+    
     cmdPtr = (Command *) cmd;
     cmdPtr->proc = infoPtr->proc;
     cmdPtr->clientData = infoPtr->clientData;
-    if (infoPtr->objProc == NULL) {
+    if (infoPtr->objProc == (Tcl_ObjCmdProc *) NULL) {
 	cmdPtr->objProc = TclInvokeStringCommand;
-	cmdPtr->objClientData = cmdPtr;
-	cmdPtr->nreProc = NULL;
+	cmdPtr->objClientData = (ClientData) cmdPtr;
     } else {
-	if (infoPtr->objProc != cmdPtr->objProc) {
-	    cmdPtr->nreProc = NULL;
-	    cmdPtr->objProc = infoPtr->objProc;
-	}
+	cmdPtr->objProc = infoPtr->objProc;
 	cmdPtr->objClientData = infoPtr->objClientData;
     }
     cmdPtr->deleteProc = infoPtr->deleteProc;
@@ -2747,9 +2315,10 @@ Tcl_SetCommandInfoFromToken(
  *	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.
@@ -2758,17 +2327,20 @@ Tcl_SetCommandInfoFromToken(
  */
 
 int
-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_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_Command cmd;
 
-    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
-    return Tcl_GetCommandInfoFromToken(cmd, infoPtr);
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+
+    return Tcl_GetCommandInfoFromToken( cmd, infoPtr );
+
 }
 
 /*
@@ -2779,9 +2351,9 @@ Tcl_GetCommandInfo(
  *	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.
@@ -2790,13 +2362,14 @@ Tcl_GetCommandInfo(
  */
 
 int
-Tcl_GetCommandInfoFromToken(
-    Tcl_Command cmd,
-    Tcl_CmdInfo *infoPtr)
+Tcl_GetCommandInfoFromToken( cmd, infoPtr )
+    Tcl_Command cmd;
+    Tcl_CmdInfo* infoPtr;
 {
-    Command *cmdPtr;		/* Internal representation of the command */
 
-    if (cmd == NULL) {
+    Command* cmdPtr;		/* Internal representation of the command */
+
+    if ( cmd == (Tcl_Command) NULL ) {
 	return 0;
     }
 
@@ -2817,6 +2390,7 @@ Tcl_GetCommandInfoFromToken(
     infoPtr->namespacePtr = (Tcl_Namespace *) cmdPtr->nsPtr;
 
     return 1;
+
 }
 
 /*
@@ -2824,8 +2398,9 @@ Tcl_GetCommandInfoFromToken(
  *
  * Tcl_GetCommandName --
  *
- *	Given a token returned by Tcl_CreateCommand, this function returns the
- *	current name of the command (which may have changed due to renaming).
+ *	Given a token returned by Tcl_CreateCommand, this procedure
+ *	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.
@@ -2836,25 +2411,25 @@ Tcl_GetCommandInfoFromToken(
  *----------------------------------------------------------------------
  */
 
-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. */
+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. */
 {
     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);
 }
 
@@ -2863,28 +2438,28 @@ Tcl_GetCommandName(
  *
  * Tcl_GetCommandFullName --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	The command's fully-qualified name is appended to the string
- *	representation of objPtr.
+ *	representation of objPtr. 
  *
  *----------------------------------------------------------------------
  */
 
 void
-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
+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
 				 * command's full name is appended. */
 
 {
@@ -2907,7 +2482,7 @@ Tcl_GetCommandFullName(
 	if (cmdPtr->hPtr != NULL) {
 	    name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
 	    Tcl_AppendToObj(objPtr, name, -1);
-	}
+	} 
     }
 }
 
@@ -2919,29 +2494,31 @@ Tcl_GetCommandFullName(
  *	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(
-    Tcl_Interp *interp,		/* Token for command interpreter (returned by
-				 * a previous Tcl_CreateInterp call). */
-    const char *cmdName)	/* Name of command to remove. */
+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_Command cmd;
 
     /*
-     * Find the desired command and delete it.
+     *  Find the desired command and delete it.
      */
 
-    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
-    if (cmd == NULL) {
+    cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace *) NULL,
+            /*flags*/ 0);
+    if (cmd == (Tcl_Command) NULL) {
 	return -1;
     }
     return Tcl_DeleteCommandFromToken(interp, cmd);
@@ -2952,26 +2529,26 @@ Tcl_DeleteCommand(
  *
  * Tcl_DeleteCommandFromToken --
  *
- *	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.
+ *	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.
  *
  * 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(
-    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(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. */
 {
     Interp *iPtr = (Interp *) interp;
     Command *cmdPtr = (Command *) cmd;
@@ -2979,91 +2556,73 @@ Tcl_DeleteCommandFromToken(
     Tcl_Command importCmd;
 
     /*
-     * 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.
+     * 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. 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]
+	 * Another deletion is already in progress.  Remove the hash
+	 * table entry now, but don't invoke a callback or free the
+	 * command structure.
 	 */
 
-	if (cmdPtr->hPtr != NULL) {
-	    Tcl_DeleteHashEntry(cmdPtr->hPtr);
-	    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.
+    /* 
+     * 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;
 
     /*
-     * Call trace functions for the command being deleted. Then delete its
-     * traces.
+     * Bump the command epoch counter. This will invalidate all cached
+     * references that point to this command.
+     */
+    
+    cmdPtr->cmdEpoch++;
+
+    /*
+     * Call trace procedures 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(tracePtr);
+		ckfree((char*)tracePtr);
 	    }
 	    tracePtr = nextPtr;
 	}
 	cmdPtr->tracePtr = NULL;
     }
-
+    
     /*
-     * 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 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.
      */
 
     if (cmdPtr->compileProc != NULL) {
-	iPtr->compileEpoch++;
+        iPtr->compileEpoch++;
     }
 
     if (cmdPtr->deleteProc != NULL) {
@@ -3072,17 +2631,19 @@ Tcl_DeleteCommandFromToken(
 	 * created when a command was imported into a namespace, this client
 	 * 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);
+	(*cmdPtr->deleteProc)(cmdPtr->deleteData);
     }
 
     /*
@@ -3091,94 +2652,79 @@ Tcl_DeleteCommandFromToken(
      * imported commands now.
      */
 
-    for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
-	    refPtr = nextRefPtr) {
+    for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
+            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;
     }
 
     /*
-     * A number of tests for particular kinds of commands are done by checking
-     * whether the objProc field holds a known value. Set the field to NULL so
-     * that such tests won't have false positives when applied to deleted
-     * commands.
+     * 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.
      */
 
     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
-     * TclNRExecuteByteCode 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).
      */
-
-    TclCleanupCommandMacro(cmdPtr);
+    
+    TclCleanupCommand(cmdPtr);
     return 0;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * CallCommandTraces --
- *
- *	Abstraction of the code to call traces on a command.
- *
- * Results:
- *	Currently always NULL.
- *
- * Side effects:
- *	Anything; this may recursively evaluate scripts and code exists to do
- *	just that.
- *
- *----------------------------------------------------------------------
- */
-
 static char *
-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. */
+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. */
 {
     register CommandTrace *tracePtr;
     ActiveCommandTrace active;
     char *result;
     Tcl_Obj *oldNamePtr = NULL;
-    Tcl_InterpState state = NULL;
+    int mask = (TCL_TRACE_DELETE | TCL_TRACE_RENAME);	/* Safety */
+
+    flags &= mask;
 
     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;
 	}
@@ -3188,7 +2734,7 @@ CallCommandTraces(
     }
     cmdPtr->flags |= CMD_TRACE_ACTIVE;
     cmdPtr->refCount++;
-
+    
     result = NULL;
     active.nextPtr = iPtr->activeCmdTracePtr;
     active.reverseScan = 0;
@@ -3198,41 +2744,37 @@ CallCommandTraces(
 	flags |= TCL_TRACE_DESTROYED;
     }
     active.cmdPtr = cmdPtr;
-
-    Tcl_Preserve(iPtr);
-
+    
+    Tcl_Preserve((ClientData) iPtr);
+    
     for (tracePtr = cmdPtr->tracePtr; tracePtr != NULL;
-	    tracePtr = active.nextTracePtr) {
+	 tracePtr = active.nextTracePtr) {
+	int traceFlags = (tracePtr->flags & mask);
+
 	active.nextTracePtr = tracePtr->nextPtr;
-	if (!(tracePtr->flags & flags)) {
+	if (!(traceFlags & flags)) {
 	    continue;
 	}
-	cmdPtr->flags |= tracePtr->flags;
+	cmdPtr->flags |= traceFlags;
 	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 &= ~tracePtr->flags;
+	(*tracePtr->traceProc)(tracePtr->clientData,
+		(Tcl_Interp *) iPtr, oldName, newName, flags);
+	cmdPtr->flags &= ~traceFlags;
 	if ((--tracePtr->refCount) <= 0) {
-	    ckfree(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) {
@@ -3240,163 +2782,26 @@ CallCommandTraces(
     }
 
     /*
-     * 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(iPtr);
+    Tcl_Release((ClientData) iPtr);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CancelEvalProc --
- *
- *	Marks this interpreter as being canceled. This causes current
- *	executions to be unwound as the interpreter enters a state where it
- *	refuses to execute more commands or handle [catch] or [try], yet the
- *	interpreter is still able to execute further commands after the
- *	cancelation is cleared (unlike if it is deleted).
- *
- * Results:
- *	The value given for the code argument.
- *
- * Side effects:
- *	Transfers a message from the cancelation message to the interpreter.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CancelEvalProc(
-    ClientData clientData,	/* Interp to cancel the script in progress. */
-    Tcl_Interp *interp,		/* Ignored */
-    int code)			/* Current return code from command. */
-{
-    CancelInfo *cancelInfo = clientData;
-    Interp *iPtr;
-
-    if (cancelInfo != NULL) {
-	Tcl_MutexLock(&cancelLock);
-	iPtr = (Interp *) cancelInfo->interp;
-
-	if (iPtr != NULL) {
-	    /*
-	     * Setting the CANCELED flag will cause the script in progress to
-	     * be canceled as soon as possible. The core honors this flag at
-	     * all the necessary places to ensure script cancellation is
-	     * responsive. Extensions can check for this flag by calling
-	     * Tcl_Canceled and checking if TCL_ERROR is returned or they can
-	     * choose to ignore the script cancellation flag and the
-	     * associated functionality altogether. Currently, the only other
-	     * flag we care about here is the TCL_CANCEL_UNWIND flag (from
-	     * Tcl_CancelEval). We do not want to simply combine all the flags
-	     * from original Tcl_CancelEval call with the interp flags here
-	     * just in case the caller passed flags that might cause behaviour
-	     * unrelated to script cancellation.
-	     */
-
-	    TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);
-
-	    /*
-	     * Now, we must set the script cancellation flags on all the slave
-	     * interpreters belonging to this one.
-	     */
-
-	    TclSetSlaveCancelFlags((Tcl_Interp *) iPtr,
-		    cancelInfo->flags | CANCELED, 0);
-
-	    /*
-	     * Create the result object now so that Tcl_Canceled can avoid
-	     * locking the cancelLock mutex.
-	     */
-
-	    if (cancelInfo->result != NULL) {
-		Tcl_SetStringObj(iPtr->asyncCancelMsg, cancelInfo->result,
-			cancelInfo->length);
-	    } else {
-		Tcl_SetObjLength(iPtr->asyncCancelMsg, 0);
-	    }
-	}
-	Tcl_MutexUnlock(&cancelLock);
-    }
-
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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. The Tcl_Obj has refCount==1.
- *
- *	*** MAINTAINER WARNING ***
- *	The returned Tcl_Obj is all wrong for any purpose but getting the
- *	source string for an objc/objv command line in the stringRep (no
- *	stringRep if no source is available) and the corresponding substituted
- *	version in the List intrep.
- *	This means that the intRep and stringRep DO NOT COINCIDE! Using these
- *	Tcl_Objs normally is likely to break things.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_Obj *
-GetCommandSource(
-    Interp *iPtr,
-    int objc,
-    Tcl_Obj *const objv[],
-    int lookup)
-{
-    Tcl_Obj *objPtr, *obj2Ptr;
-    CmdFrame *cfPtr = iPtr->cmdFramePtr;
-    const char *command = NULL;
-    int numChars;
-
-    objPtr = Tcl_NewListObj(objc, objv);
-    if (lookup && cfPtr && (cfPtr->numLevels == iPtr->numLevels-1)) {
-	switch (cfPtr->type) {
-	case TCL_LOCATION_EVAL:
-	case TCL_LOCATION_SOURCE:
-	    command = cfPtr->cmd.str.cmd;
-	    numChars = cfPtr->cmd.str.len;
-	    break;
-	case TCL_LOCATION_BC:
-	case TCL_LOCATION_PREBC:
-	    command = TclGetSrcInfoForCmd(iPtr, &numChars);
-	    break;
-	case TCL_LOCATION_EVAL_LIST:
-	    /* Got it already */
-	    break;
-	}
-	if (command) {
-	    obj2Ptr = Tcl_NewStringObj(command, numChars);
-	    objPtr->bytes = obj2Ptr->bytes;
-	    objPtr->length = numChars;
-	    obj2Ptr->bytes = NULL;
-	    Tcl_DecrRefCount(obj2Ptr);
-	}
-    }
-    Tcl_IncrRefCount(objPtr);
-    return objPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclCleanupCommand --
  *
- *	This function frees up a Command structure unless it is still
+ *	This procedure 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.
@@ -3410,13 +2815,13 @@ GetCommandSource(
  */
 
 void
-TclCleanupCommand(
-    register Command *cmdPtr)	/* Points to the Command structure to
+TclCleanupCommand(cmdPtr)
+    register Command *cmdPtr;	/* Points to the Command structure to
 				 * be freed. */
 {
     cmdPtr->refCount--;
     if (cmdPtr->refCount <= 0) {
-	ckfree(cmdPtr);
+	ckfree((char *) cmdPtr);
     }
 }
 
@@ -3425,17 +2830,18 @@ TclCleanupCommand(
  *
  * 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 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,
+ *	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,
  *	redefioning a non-builtin function will force existing code to be
  *	invalidated if the number of arguments has changed.
  *
@@ -3443,203 +2849,65 @@ TclCleanupCommand(
  */
 
 void
-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. */
-{
-    Tcl_DString bigName;
-    OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
-
-    data->proc = proc;
-    data->numArgs = numArgs;
-    data->argTypes = 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.
- *
- *----------------------------------------------------------------------
- */
-
-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_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_Obj *valuePtr;
-    OldMathFuncData *dataPtr = clientData;
-    Tcl_Value funcResult, *args;
-    int result;
-    int j, k;
-    double d;
-
-    /*
-     * Check argument count.
-     */
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    MathFunc *mathFuncPtr;
+    int new, i;
 
-    if (objc != dataPtr->numArgs + 1) {
-	MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
-	return TCL_ERROR;
+    hPtr = Tcl_CreateHashEntry(&iPtr->mathFuncTable, name, &new);
+    if (new) {
+	Tcl_SetHashValue(hPtr, ckalloc(sizeof(MathFunc)));
     }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
 
-    /*
-     * Convert arguments from Tcl_Obj's to Tcl_Value's.
-     */
-
-    args = 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) {
+    if (!new) {	
+	if (mathFuncPtr->builtinFuncIndex >= 0) {
 	    /*
-	     * We have a non-numeric argument.
+	     * 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.
 	     */
 
-	    Tcl_SetResult(interp,
-		    "argument to math function didn't have numeric value",
-		    TCL_STATIC);
-	    TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
-	    ckfree(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.
-	 */
+	    iPtr->compileEpoch++;
+	} else {
+	    /*
+	     * 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.
+	     */
 
-	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;
+	    if (numArgs != mathFuncPtr->numArgs) {
+		iPtr->compileEpoch++;
 	    }
-	    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(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(args);
-		return TCL_ERROR;
-	    }
-	    valuePtr = Tcl_GetObjResult(interp);
-	    Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
-	    Tcl_ResetResult(interp);
-	    break;
 	}
     }
-
-    /*
-     * Call the function.
-     */
-
-    errno = 0;
-    result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
-    ckfree(args);
-    if (result != TCL_OK) {
-	return result;
+    
+    mathFuncPtr->builtinFuncIndex = -1;	/* can't be a builtin function */
+    if (numArgs > MAX_MATH_ARGS) {
+	numArgs = MAX_MATH_ARGS;
     }
-
-    /*
-     * 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->numArgs = numArgs;
+    for (i = 0;  i < numArgs;  i++) {
+	mathFuncPtr->argTypes[i] = argTypes[i];
     }
-    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(dataPtr->argTypes);
-    ckfree(dataPtr);
+    mathFuncPtr->proc = proc;
+    mathFuncPtr->clientData = clientData;
 }
 
 /*
@@ -3651,77 +2919,64 @@ OldMathFuncDeleteProc(
  *	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(
-    Tcl_Interp *interp,
-    const char *name,
-    int *numArgsPtr,
-    Tcl_ValueType **argTypesPtr,
-    Tcl_MathProc **procPtr,
-    ClientData *clientDataPtr)
+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_Obj *cmdNameObj;
-    Command *cmdPtr;
-
-    /*
-     * 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.
-     */
+    Interp *iPtr = (Interp *) interp;
+    Tcl_HashEntry *hPtr;
+    MathFunc *mathFuncPtr;
+    Tcl_ValueType *argTypes;
+    int i,numArgs;
 
-    if (cmdPtr == NULL) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "unknown math function \"%s\"", name));
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
-	*numArgsPtr = -1;
-	*argTypesPtr = NULL;
-	*procPtr = NULL;
-	*clientDataPtr = NULL;
+    hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, name);
+    if (hPtr == NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "math function \"", name, "\" not known in this interpreter",
+		(char *) NULL);
 	return TCL_ERROR;
     }
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
 
-    /*
-     * Retrieve function info for user defined functions; return dummy
-     * information for builtins.
-     */
-
-    if (cmdPtr->objProc == &OldMathFuncProc) {
-	OldMathFuncData *dataPtr = cmdPtr->clientData;
+    *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];
+    }
 
-	*procPtr = dataPtr->proc;
-	*numArgsPtr = dataPtr->numArgs;
-	*argTypesPtr = dataPtr->argTypes;
-	*clientDataPtr = dataPtr->clientData;
+    if (mathFuncPtr->builtinFuncIndex == -1) {
+	*procPtr = (Tcl_MathProc *) NULL;
     } else {
-	*procPtr = NULL;
-	*numArgsPtr = -1;
-	*argTypesPtr = NULL;
-	*procPtr = NULL;
-	*clientDataPtr = NULL;
+	*procPtr = mathFuncPtr->proc;
+	*clientDataPtr = mathFuncPtr->clientData;
     }
+
     return TCL_OK;
 }
 
@@ -3734,9 +2989,9 @@ Tcl_GetMathFuncInfo(
  *	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.
@@ -3745,46 +3000,28 @@ Tcl_GetMathFuncInfo(
  */
 
 Tcl_Obj *
-Tcl_ListMathFuncs(
-    Tcl_Interp *interp,
-    const char *pattern)
+Tcl_ListMathFuncs(interp, pattern)
+    Tcl_Interp *interp;
+    CONST char *pattern;
 {
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    Namespace *nsPtr;
-    Namespace *dummy1NsPtr;
-    Namespace *dummy2NsPtr;
-    const char *dummyNamePtr;
-    Tcl_Obj *result = Tcl_NewObj();
-
-    TclGetNamespaceForQualName(interp, "::tcl::mathfunc",
-	    globalNsPtr, TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY,
-	    &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &dummyNamePtr);
-    if (nsPtr == NULL) {
-	return result;
-    }
-
-    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
-	if (Tcl_FindHashEntry(&nsPtr->cmdTable, pattern) != NULL) {
-	    Tcl_ListObjAppendElement(NULL, result,
-		    Tcl_NewStringObj(pattern, -1));
-	}
-    } else {
-	Tcl_HashSearch cmdHashSearch;
-	Tcl_HashEntry *cmdHashEntry =
-		Tcl_FirstHashEntry(&nsPtr->cmdTable,&cmdHashSearch);
-
-	for (; cmdHashEntry != NULL;
-		cmdHashEntry = Tcl_NextHashEntry(&cmdHashSearch)) {
-	    const char *cmdNamePtr =
-		    Tcl_GetHashKey(&nsPtr->cmdTable, cmdHashEntry);
-
-	    if (pattern == NULL || Tcl_StringMatch(cmdNamePtr, pattern)) {
-		Tcl_ListObjAppendElement(NULL, result,
-			Tcl_NewStringObj(cmdNamePtr, -1));
-	    }
+    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;
 	}
     }
-    return result;
+    return resultList;
 }
 
 /*
@@ -3792,12 +3029,13 @@ Tcl_ListMathFuncs(
  *
  * 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.
@@ -3805,15 +3043,15 @@ Tcl_ListMathFuncs(
  *----------------------------------------------------------------------
  */
 
-int
-TclInterpReady(
-    Tcl_Interp *interp)
+int 
+TclInterpReady(interp)
+    Tcl_Interp *interp;
 {
     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);
@@ -3821,1013 +3059,790 @@ TclInterpReady(
     /*
      * If the interpreter has been deleted, return an error.
      */
-
+    
     if (iPtr->flags & DELETED) {
-	/* JJM - Superfluous Tcl_ResetResult call removed. */
-	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;
-    }
-
-    if (iPtr->execEnvPtr->rewind) {
+	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);
 	return TCL_ERROR;
     }
 
     /*
-     * Make sure the script being evaluated (if any) has not been canceled.
+     * Check depth of nested calls to Tcl_Eval:  if this gets too large,
+     * it's probably because of an infinite loop somewhere.
      */
 
-    if (TclCanceled(iPtr) &&
-	    (TCL_OK != Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG))) {
+    if (((iPtr->numLevels) > iPtr->maxNestingDepth) 
+	    || (TclpCheckStackSpace() == 0)) {
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"too many nested evaluations (infinite loop?)", -1); 
 	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.
-     */
-
-    if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) {
-	return TCL_OK;
-    }
-
-    Tcl_AppendResult(interp,
-	    "too many nested evaluations (infinite loop?)", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
-    return TCL_ERROR;
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclResetCancellation --
+ * TclEvalObjvInternal --
  *
- *	Reset the script cancellation flags if the nesting level
- *	(iPtr->numLevels) for the interp is zero or argument force is
- *	non-zero.
+ *	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.
  *
  * Results:
- *	A standard Tcl 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.  If an error occurs, this procedure does
+ *	NOT add any information to the errorInfo variable.
  *
  * Side effects:
- *	The script cancellation flags for the interp may be reset.
+ *	Depends on the command.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclResetCancellation(
-    Tcl_Interp *interp,
-    int force)
+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
+				 * 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
+				 * characters up to the first null byte are
+				 * used. */
+    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. */
+
 {
-    register Interp *iPtr = (Interp *) interp;
+    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. */
+    int code = TCL_OK;
+    int traceCode = TCL_OK;
+    int checkTraces = 1;
+    Namespace *savedNsPtr = NULL;
 
-    if (iPtr == NULL) {
+    if (TclInterpReady(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }
 
-    if (force || (iPtr->numLevels == 0)) {
-	TclUnsetCancelFlags(iPtr);
+    if (objc == 0) {
+	return TCL_OK;
     }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_Canceled --
- *
- *	Check if the script in progress has been canceled, i.e.,
- *	Tcl_CancelEval was called for this interpreter or any of its master
- *	interpreters.
- *
- * Results:
- *	The return value is TCL_OK if the script evaluation has not been
- *	canceled, TCL_ERROR otherwise.
- *
- *	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. If "flags" contains TCL_CANCEL_UNWIND,
- *	TCL_ERROR will only be returned if the script evaluation is being
- *	completely unwound.
- *
- * Side effects:
- *	The CANCELED flag for the interp will be reset if it is set.
- *
- *----------------------------------------------------------------------
- */
 
-int
-Tcl_Canceled(
-    Tcl_Interp *interp,
-    int flags)
-{
-    register Interp *iPtr = (Interp *) interp;
 
     /*
-     * Has the current script in progress for this interpreter been canceled
-     * or is the stack being unwound due to the previous script cancellation?
+     * If any execution traces rename or delete the current command,
+     * we may need (at most) two passes here.
      */
 
-    if (!TclCanceled(iPtr)) {
-        return TCL_OK;
+    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;
+	    } else {
+	        iPtr->numLevels++;
+	        code = TclEvalObjvInternal(interp, objc+1, newObjv,
+			command, length, 0);
+	        iPtr->numLevels--;
+	    }
+	    Tcl_DecrRefCount(newObjv[0]);
+	    ckfree((char *) newObjv);
+	    if (savedNsPtr) {
+		iPtr->varFramePtr->nsPtr = savedNsPtr;
+	    }
+	    goto done;
+        }
+	if (savedNsPtr) {
+	    iPtr->varFramePtr->nsPtr = savedNsPtr;
+	}
+    
+        /*
+         * 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;
     }
 
-    /*
-     * The CANCELED flag is a one-shot flag that is reset immediately upon
-     * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will
-     * continue to report that the script in progress has been canceled
-     * thereby allowing the evaluation stack for the interp to be fully
-     * unwound.
-     */
+#ifdef USE_DTRACE
+    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
+	char *a[10];
+	int i = 0;
 
-    iPtr->flags &= ~CANCELED;
+	while (i < 10) {
+	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
+	}
+	TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+		a[8], a[9]);
+    }
+#endif /* USE_DTRACE */
 
     /*
-     * The CANCELED flag was detected and reset; however, if the caller
-     * specified the TCL_CANCEL_UNWIND flag, we only return TCL_ERROR
-     * (indicating that the script in progress has been canceled) if the
-     * evaluation stack for the interp is being fully unwound.
+     * Finally, invoke the command's Tcl_ObjCmdProc.
      */
-
-    if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
-        return TCL_OK;
+    cmdPtr->refCount++;
+    iPtr->cmdCount++;
+    if ( code == TCL_OK && traceCode == TCL_OK) {
+	if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
+	    TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
+		    (Tcl_Obj **)(objv + 1));
+	}
+	code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+	if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
+	    TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
+	}
+    }
+    if (Tcl_AsyncReady()) {
+	code = Tcl_AsyncInvoke(interp, code);
     }
 
     /*
-     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
-     * interp's result; otherwise, we leave it alone.
+     * Call 'leave' command traces
      */
-
-    if (flags & TCL_LEAVE_ERR_MSG) {
-        const char *id, *message = NULL;
-        int length;
-
-        /*
-         * Setup errorCode variables so that we can differentiate between
-         * being canceled and unwound.
-         */
-
-        if (iPtr->asyncCancelMsg != NULL) {
-            message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
-        } else {
-            length = 0;
+    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->flags & TCL_CANCEL_UNWIND) {
-            id = "IUNWIND";
-            if (length == 0) {
-                message = "eval unwound";
-            }
-        } else {
-            id = "ICANCEL";
-            if (length == 0) {
-                message = "eval canceled";
-            }
+        if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
+            traceCode = TclCheckInterpTraces(interp, command, length,
+                   cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
         }
-
-        Tcl_ResetResult(interp);
-        Tcl_AppendResult(interp, message, NULL);
-        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
+	if (traceCode == TCL_OK) {
+	    iPtr->flags |= saveErrFlags;
+	}
     }
+    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.  
+     */
 
+    if (traceCode != TCL_OK) {
+	code = traceCode;
+    }
+    
     /*
-     * Return TCL_ERROR to the caller (not necessarily just the Tcl core
-     * itself) that indicates further processing of the script or command in
-     * progress should halt gracefully and as soon as possible.
+     * 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 (*(iPtr->result) != 0) {
+	(void) Tcl_GetObjResult(interp);
+    }
+
+#ifdef USE_DTRACE
+    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
+	Tcl_Obj *r;
+
+	r = Tcl_GetObjResult(interp);
+	TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r), r);
+    }
+#endif /* USE_DTRACE */
 
-    return TCL_ERROR;
+    done:
+    iPtr->varFramePtr = savedVarFramePtr;
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_CancelEval --
+ * Tcl_EvalObjv --
  *
- *	This function schedules the cancellation of the current script in the
- *	given interpreter.
+ *	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. Since the interp may belong to a different thread, no error
- *	message can be left in the 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:
- *	The script in progress in the specified interpreter will be canceled
- *	with TCL_ERROR after asynchronous handlers are invoked at the next
- *	Tcl_Canceled check.
+ *	Depends on the command.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_CancelEval(
-    Tcl_Interp *interp,		/* Interpreter in which to cancel the
-				 * script. */
-    Tcl_Obj *resultObjPtr,	/* The script cancellation error message or
-				 * NULL for a default error message. */
-    ClientData clientData,	/* Passed to CancelEvalProc. */
-    int flags)			/* Collection of OR-ed bits that control
-				 * the cancellation of the script. Only
-				 * TCL_CANCEL_UNWIND is currently
-				 * supported. */
-{
-    Tcl_HashEntry *hPtr;
-    CancelInfo *cancelInfo;
-    int code = TCL_ERROR;
-    const char *result;
+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);
 
-    if (interp == NULL) {
-	return TCL_ERROR;
+    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]));
+	    }
+	    cmdString = Tcl_DStringValue(&cmdBuf);
+	    cmdLen = Tcl_DStringLength(&cmdBuf);
+	    break;
+	}
     }
 
-    Tcl_MutexLock(&cancelLock);
-    if (cancelTableInitialized != 1) {
-	/*
-	 * No CancelInfo hash table (Tcl_CreateInterp has never been called?)
-	 */
+    iPtr->numLevels++;
+    code = TclEvalObjvInternal(interp, objc, objv, cmdString, cmdLen, flags);
+    iPtr->numLevels--;
 
-	goto done;
+    /*
+     * 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 ((code != TCL_OK) && (code != TCL_ERROR) 
+	    && !allowExceptions) {
+	    ProcessUnexpectedResult(interp, code);
+	    code = TCL_ERROR;
+	}
     }
-    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) interp);
-    if (hPtr == NULL) {
-	/*
-	 * No CancelInfo record for this interpreter.
+	    
+    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 if it was not done previously.
 	 */
 
-	goto done;
+	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);
+	}
+	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
     }
-    cancelInfo = Tcl_GetHashValue(hPtr);
 
-    /*
-     * Populate information needed by the interpreter thread to fulfill the
-     * cancellation request. Currently, clientData is ignored. If the
-     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
-     * allowed to catch the script cancellation because the evaluation stack
-     * for the interp is completely unwound.
-     */
-
-    if (resultObjPtr != NULL) {
-	result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
-	cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
-	memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
-	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
-    } else {
-	cancelInfo->result = NULL;
-	cancelInfo->length = 0;
+    if (cmdLen != 0) {
+	Tcl_DStringFree(&cmdBuf);
     }
-    cancelInfo->clientData = clientData;
-    cancelInfo->flags = flags;
-    Tcl_AsyncMark(cancelInfo->async);
-    code = TCL_OK;
-
-  done:
-    Tcl_MutexUnlock(&cancelLock);
     return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_InterpActive --
+ * Tcl_LogCommandInfo --
  *
- *	Returns non-zero if the specified interpreter is in use, i.e. if there
- *	is an evaluation currently active in the interpreter.
+ *	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.
  *
  * Results:
- *	See above.
- *
- * Side effects:
  *	None.
  *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_InterpActive(
-    Tcl_Interp *interp)
-{
-    return ((Interp *) interp)->numLevels > 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_EvalObjv --
- *
- *	This function 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:
- *	Always pushes a callback. Other side effects depend on the command.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-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, TCL_EVAL_INVOKE and
-				 * TCL_EVAL_NOERR are currently supported. */
-{
-    int result;
-    NRE_callback *rootPtr = TOP_CB(interp);
-
-    result = TclNREvalObjv(interp, objc, objv, flags, NULL);
-    return TclNRRunCallbacks(interp, result, rootPtr);
-}
-
-int
-TclNREvalObjv(
-    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, TCL_EVAL_INVOKE and
-				 * TCL_EVAL_NOERR are currently supported. */
-    Command *cmdPtr)		/* NULL if the Command is to be looked up
-				 * here, otherwise the pointer to the
-				 * requested Command struct to be invoked. */
-{
+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). */
+{
+    char buffer[200];
+    register CONST char *p;
+    char *ellipsis = "";
     Interp *iPtr = (Interp *) interp;
-    int result;
-    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
-    Command **cmdPtrPtr;
-
-    iPtr->lookupNsPtr = NULL;
-
-    /*
-     * Push a callback with cleanup tasks for commands; the cmdPtr at data[0]
-     * will be filled later when the command is found: save its address at
-     * objProcPtr.
-     *
-     * data[1] stores a marker for use by tailcalls; it will be set to 1 by
-     * command redirectors (imports, alias, ensembles) so that tailcalls
-     * finishes the source command and not just the target.
-     */
-
-    if (iPtr->evalFlags & TCL_EVAL_REDIRECT) {
-	TclNRAddCallback(interp, NRCommand, NULL, INT2PTR(1), INT2PTR(objc), objv);
-	iPtr->evalFlags &= ~TCL_EVAL_REDIRECT;
-    } else {
-	TclNRAddCallback(interp, NRCommand, NULL, NULL, INT2PTR(objc), objv);
-    }
-    cmdPtrPtr = (Command **) &(TOP_CB(interp)->data[0]);
-
-    TclNRSpliceDeferred(interp);
 
-    iPtr->numLevels++;
-    result = TclInterpReady(interp);
-
-    if ((result != TCL_OK) || (objc == 0)) {
-	return result;
-    }
-
-    if (cmdPtr) {
-	goto commandFound;
-    }
-
-    /*
-     * Push records for task to be done on return, in INVERSE order. First, if
-     * needed, the exception handlers (as they should happen last).
-     */
+    if (iPtr->flags & ERR_ALREADY_LOGGED) {
+	/*
+	 * Someone else has already logged error information for this
+	 * command; we shouldn't add anything more.
+	 */
 
-    if (!(flags & TCL_EVAL_NOERR)) {
-	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
+	return;
     }
 
     /*
-     * Configure evaluation context to match the requested flags.
+     * Compute the line number where the error occurred.
      */
 
-    if ((flags & TCL_EVAL_INVOKE) || lookupNsPtr) {
-	if (!lookupNsPtr) {
-	    lookupNsPtr = iPtr->globalNsPtr;
-	}
-    } else {
-	if (flags & TCL_EVAL_GLOBAL) {
-	    TEOV_SwitchVarFrame(interp);
-	    lookupNsPtr = iPtr->globalNsPtr;
+    iPtr->errorLine = 1;
+    for (p = script; p != command; p++) {
+	if (*p == '\n') {
+	    iPtr->errorLine++;
 	}
-
-	/*
-	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
-	 */
-
-	iPtr->ensembleRewrite.sourceObjs = NULL;
     }
 
     /*
-     * Lookup the command
+     * Create an error message to add to errorInfo, including up to a
+     * maximum number of characters of the command.
      */
 
-    cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
-    if (!cmdPtr) {
-	return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
+    if (length < 0) {
+	length = strlen(command);
     }
-
-    iPtr->cmdCount++;
-    if (TclLimitExceeded(iPtr->limit)) {
-	return TCL_ERROR;
+    if (length > 150) {
+	length = 150;
+	ellipsis = "...";
     }
-
-    /*
-     * Found a command! The real work begins now ...
-     */
-
-  commandFound:
-    if (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
+    while ( (command[length] & 0xC0) == 0x80 ) {
 	/*
-	 * Call enter traces. They will schedule a call to the leave traces if
-	 * necessary.
+	 * Back up truncation point so that we don't truncate in the
+	 * middle of a multi-byte character (in UTF-8)
 	 */
-
-	result = TEOV_RunEnterTraces(interp, &cmdPtr, objc, objv, lookupNsPtr);
-	if (!cmdPtr) {
-	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
-	}
-	if (result != TCL_OK) {
-	    return result;
-	}
-    }
-
-
-#ifdef USE_DTRACE
-    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
-	const char *a[10];
-	int i = 0;
-
-	while (i < 10) {
-	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
-	}
-	TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
-		a[8], a[9]);
+	length--;
+	ellipsis = "...";
     }
-    if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
-	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
-	const char *a[6]; int i[2];
-
-	TclDTraceInfo(info, a, i);
-	TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
-	TclDecrRefCount(info);
-    }
-    if (TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED()) {
-	TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
-    }
-    if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
-	TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
-		(Tcl_Obj **)(objv + 1));
-    }
-#endif /* USE_DTRACE */
-    /*
-     * Fix the original callback to point to the now known cmdPtr. Insure that
-     * the Command struct lives until the command returns.
-     */
-
-    *cmdPtrPtr = cmdPtr;
-    cmdPtr->refCount++;
-
-    /*
-     * Find the objProc to call: nreProc if available, objProc otherwise. Push
-     * a callback to do the actual running.
-     */
-
-    if (cmdPtr->nreProc) {
-        TclNRAddCallback(interp, NRRunObjProc, cmdPtr,
-                INT2PTR(objc), (ClientData) objv, NULL);
-        return TCL_OK;
+    if (!(iPtr->flags & ERR_IN_PROGRESS)) {
+	sprintf(buffer, "\n    while executing\n\"%.*s%s\"",
+		length, command, ellipsis);
     } else {
-	return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
+	sprintf(buffer, "\n    invoked from within\n\"%.*s%s\"",
+		length, command, ellipsis);
     }
+    Tcl_AddObjErrorInfo(interp, buffer, -1);
+    iPtr->flags &= ~ERR_ALREADY_LOGGED;
 }
-
-void
-TclPushTailcallPoint(
-    Tcl_Interp *interp)
-{
-    TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
-    ((Interp *) interp)->numLevels++;
-}
-
-int
-TclNRRunCallbacks(
-    Tcl_Interp *interp,
-    int result,
-    struct NRE_callback *rootPtr)
-				/* All callbacks down to rootPtr not inclusive
-				 * are to be run. */
-{
-    Interp *iPtr = (Interp *) interp;
-    NRE_callback *callbackPtr;
-    Tcl_NRPostProc *procPtr;
-
-    /*
-     * 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.
-     *
-     * This only needs to be done for the first item in the list: all other
-     * are for NR function calls, and those are Tcl_Obj based.
-     */
-
-    if (*(iPtr->result) != 0) {
-	(void) Tcl_GetObjResult(interp);
-    }
-
-    while (TOP_CB(interp) != rootPtr) {
-	callbackPtr = TOP_CB(interp);
-	procPtr = callbackPtr->procPtr;
-	TOP_CB(interp) = callbackPtr->nextPtr;
-	result = procPtr(callbackPtr->data, interp, result);
-	TCLNR_FREE(interp, callbackPtr);
-    }
-    return result;
-}
-
-int
-NRCommand(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    Command *cmdPtr = data[0];
-    /* int cmdStart = PTR2INT(data[1]); NOT USED HERE */
-
-    if (cmdPtr) {
-	TclCleanupCommandMacro(cmdPtr);
-    }
-    ((Interp *)interp)->numLevels--;
-
-    /* OPT ??
-     * Do not interrupt a series of cleanups with async or limit checks:
-     * just check at the end?
-     */
-
-    if (TclAsyncReady(iPtr)) {
-	result = Tcl_AsyncInvoke(interp, result);
-    }
-    if ((result == TCL_OK) && TclCanceled(iPtr)) {
-	result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG);
-    }
-    if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
-	result = Tcl_LimitCheck(interp);
-    }
-
-    return result;
-}
-
-static int
-NRRunObjProc(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    /* OPT: do not call? */
-
-    Command* cmdPtr = data[0];
-    int objc = PTR2INT(data[1]);
-    Tcl_Obj **objv = data[2];
-
-    return cmdPtr->nreProc(cmdPtr->objClientData, interp, objc, objv);
-}
-
 
 /*
  *----------------------------------------------------------------------
  *
- * TEOV_Exception	 -
- * TEOV_LookupCmdFromObj -
- * TEOV_RunEnterTraces	 -
- * TEOV_RunLeaveTraces	 -
- * TEOV_NotFound	 -
+ * Tcl_EvalTokensStandard, EvalTokensStandard --
  *
- *	These are helper functions for Tcl_EvalObjv.
+ *	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.
+ *
+ * Side effects:
+ *	Depends on the array of tokens being evaled.
  *
+ * TIP #280 : Keep public API, internally extended API.
  *----------------------------------------------------------------------
  */
 
-static void
-TEOV_PushExceptionHandlers(
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[],
-    int flags)
+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.
+				 * Must be at least 1. */
 {
-    Interp *iPtr = (Interp *) interp;
-
-    /*
-     * If any error processing is necessary, push the appropriate records.
-     * Note that we have to push them in the inverse order: first the one that
-     * has to run last.
-     */
-
-    if (!(flags & TCL_EVAL_INVOKE)) {
-	/*
-	 * Error messages
-	 */
-
-	TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc),
-		(ClientData) objv, NULL, NULL);
-    }
-
-    if (iPtr->numLevels == 1) {
-	/*
-	 * No CONTINUE or BREAK at level 0, manage RETURN
-	 */
-
-	TclNRAddCallback(interp, TEOV_Exception, INT2PTR(iPtr->evalFlags),
-		NULL, NULL, NULL);
-    }
+#ifdef TCL_TIP280
+  return EvalTokensStandard (interp, tokenPtr, count, 1, NULL, NULL);
 }
 
-static void
-TEOV_SwitchVarFrame(
-    Tcl_Interp *interp)
+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.
+			      */
 {
-    Interp *iPtr = (Interp *) interp;
+#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
 
     /*
-     * Change the varFrame to be the rootVarFrame, and push a record to
-     * restore things at the end.
+     * 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.
      */
 
-    TclNRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL,
-	    NULL, NULL);
-    iPtr->varFramePtr = iPtr->rootFramePtr;
-}
-
-static int
-TEOV_RestoreVarFrame(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    ((Interp *) interp)->varFramePtr = data[0];
-    return result;
-}
-
-static int
-TEOV_Exception(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    int allowExceptions = (PTR2INT(data[0]) & TCL_ALLOW_EXCEPTIONS);
-
-    if (result != TCL_OK) {
-	if (result == TCL_RETURN) {
-	    result = TclUpdateReturnInfo(iPtr);
-	}
-	if ((result != TCL_ERROR) && !allowExceptions) {
-	    ProcessUnexpectedResult(interp, result);
-	    result = TCL_ERROR;
+    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;
 	}
     }
 
-    /*
-     * We are returning to level 0, so should process TclResetCancellation. As
-     * numLevels has not *yet* been decreased, do not call it: do the thing
-     * here directly.
-     */
-
-    TclUnsetCancelFlags(iPtr);
-    return result;
-}
-
-static int
-TEOV_Error(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *listPtr;
-    const char *cmdString;
-    int cmdLen;
-    int objc = PTR2INT(data[0]);
-    Tcl_Obj **objv = data[1];
+    if (isLiteral) {
+	maxNumCL   = NUM_STATIC_POS;
+	clPosition = (int*) ckalloc (maxNumCL*sizeof(int));
+    }
+    adjust = 0;
+#endif
+    for ( ; count > 0; count--, tokenPtr++) {
+	valuePtr = NULL;
 
-    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)){
 	/*
-	 * If there was an error, a command string will be needed for the
-	 * error log: get it out of the itemPtr. The details depend on the
-	 * type.
+	 * The switch statement below computes the next value to be
+	 * concat to the result, as either a range of text or an
+	 * object.
 	 */
 
-	listPtr = Tcl_NewListObj(objc, objv);
-	cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
-	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
-	Tcl_DecrRefCount(listPtr);
-    }
-    iPtr->flags &= ~ERR_ALREADY_LOGGED;
-    return result;
-}
-
-static int
-TEOV_NotFound(
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[],
-    Namespace *lookupNsPtr)
-{
-    Command * cmdPtr;
-    Interp *iPtr = (Interp *) interp;
-    int i, newObjc, handlerObjc;
-    Tcl_Obj **newObjv, **handlerObjv;
-    CallFrame *varFramePtr = iPtr->varFramePtr;
-    Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered
-				 * unknown command handler for the current
-				 * namespace (TIP 181). */
-    Namespace *savedNsPtr = NULL;
+	switch (tokenPtr->type) {
+	    case TCL_TOKEN_TEXT:
+		p = tokenPtr->start;
+		length = tokenPtr->size;
+		break;
 
-    currNsPtr = varFramePtr->nsPtr;
-    if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
-	currNsPtr = iPtr->globalNsPtr;
-	if (currNsPtr == NULL) {
-	    Tcl_Panic("Tcl_EvalObjv: NULL global namespace pointer");
-	}
-    }
+	    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.
+		 */
 
-    /*
-     * Check to see if the resolution namespace has lost its unknown handler.
-     * If so, reset it to "::unknown".
-     */
+		if ((length == 1) && (buffer[0] == ' ') &&
+		    (tokenPtr->start[1] == '\n')) {
+		    if (isLiteral) {
+			int clPos;
+			if (resultPtr == 0) {
+			    clPos = 0;
+			} else {
+			    Tcl_GetStringFromObj(resultPtr, &clPos);
+			}
 
-    if (currNsPtr->unknownHandlerPtr == NULL) {
-	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
-	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
-    }
+			if (numCL >= maxNumCL) {
+			    maxNumCL *= 2;
+			    clPosition = (int*) ckrealloc ((char*)clPosition,
+							   maxNumCL*sizeof(int));
+			}
+			clPosition[numCL] = clPos;
+			numCL ++;
+		    }
+		    adjust ++;
+		}
+#endif
+		break;
 
-    /*
-     * 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.
-     */
+	    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);
 
-    Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
-	    &handlerObjc, &handlerObjv);
-    newObjc = objc + handlerObjc;
-    newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);
+		    /*
+		     * 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;
+	    }
 
-    /*
-     * 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.
-     */
+	    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);
+		}
 
-    for (i = 0; i < handlerObjc; ++i) {
-	newObjv[i] = handlerObjv[i];
-	Tcl_IncrRefCount(newObjv[i]);
-    }
-    memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
+		/*
+		 * 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.
+		 */
 
-    /*
-     * 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.
-     *
-     * In this case we worry a bit less about recursion for now, and call the
-     * "blocking" interface.
-     */
+		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;
 
-    cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
-    if (cmdPtr == NULL) {
-	Tcl_AppendResult(interp, "invalid command name \"",
-		TclGetString(objv[0]), "\"", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
-                TclGetString(objv[0]), NULL);
+	    default:
+		panic("unexpected token type in Tcl_EvalTokensStandard");
+	}
 
 	/*
-	 * Release any resources we locked and allocated during the handler
-	 * call.
+	 * If valuePtr isn't NULL, the next piece of text comes from that
+	 * object; otherwise, take length bytes starting at p.
 	 */
 
-	for (i = 0; i < handlerObjc; ++i) {
-	    Tcl_DecrRefCount(newObjv[i]);
+	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);
 	}
-	TclStackFree(interp, newObjv);
-	return TCL_ERROR;
-    }
-
-    if (lookupNsPtr) {
-	savedNsPtr = varFramePtr->nsPtr;
-	varFramePtr->nsPtr = lookupNsPtr;
-    }
-    TclNRDeferCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
-	    newObjv, savedNsPtr, NULL);
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
-    return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
-}
-
-static int
-TEOV_NotFoundCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    int objc = PTR2INT(data[0]);
-    Tcl_Obj **objv = data[1];
-    Namespace *savedNsPtr = data[2];
-
-    int i;
-
-    if (savedNsPtr) {
-	iPtr->varFramePtr->nsPtr = savedNsPtr;
-    }
-
-    /*
-     * Release any resources we locked and allocated during the handler call.
-     */
-
-    for (i = 0; i < objc; ++i) {
-	Tcl_DecrRefCount(objv[i]);
-    }
-    TclStackFree(interp, objv);
-
-    return result;
-}
-
-static int
-TEOV_RunEnterTraces(
-    Tcl_Interp *interp,
-    Command **cmdPtrPtr,
-    int objc,
-    Tcl_Obj *const objv[],
-    Namespace *lookupNsPtr)
-{
-    Interp *iPtr = (Interp *) interp;
-    Command *cmdPtr = *cmdPtrPtr;
-    int traceCode = TCL_OK;
-    int cmdEpoch = cmdPtr->cmdEpoch;
-    int newEpoch;
-    const char *command;
-    int length;
-    Tcl_Obj *commandPtr;
-
-    commandPtr = GetCommandSource(iPtr, objc, objv, 1);
-    command = Tcl_GetStringFromObj(commandPtr, &length);
-
-    /*
-     * Call trace functions.
-     * 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 = TclCheckInterpTraces(interp, command, length,
-		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
-    }
-    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
-	traceCode = TclCheckExecutionTraces(interp, command, length,
-		cmdPtr, TCL_OK, 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. We need to lookup again, but do not
-     * run enter traces on the newly found cmdPtr.
-     */
-
-    if (cmdEpoch != newEpoch) {
-	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
-	*cmdPtrPtr = cmdPtr;
     }
-
-    if (cmdPtr) {
+    if (resultPtr != NULL) {
+	Tcl_SetObjResult(interp, resultPtr);
+#ifdef TCL_TIP280
 	/*
-	 * Command was found: push a record to schedule the leave traces.
+	 * 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.
 	 */
 
-	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(traceCode),
-		commandPtr, cmdPtr, NULL);
-	cmdPtr->refCount++;
-    } else {
-	Tcl_DecrRefCount(commandPtr);
-    }
-    return traceCode;
-}
-
-static int
-TEOV_RunLeaveTraces(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    const char *command;
-    int length, objc;
-    Tcl_Obj **objv;
-    int traceCode = PTR2INT(data[0]);
-    Tcl_Obj *commandPtr = data[1];
-    Command *cmdPtr = data[2];
-
-    command = Tcl_GetStringFromObj(commandPtr, &length);
-    if (TCL_OK != Tcl_ListObjGetElements(interp, commandPtr, &objc, &objv)) {
-	Tcl_Panic("Who messed with commandPtr?");
-    }
-
-    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
-	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
-	    traceCode = TclCheckExecutionTraces(interp, command, length,
-		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
+	if (numCL) {
+	    TclContinuationsEnter(resultPtr, numCL, clPosition);
 	}
-	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
-	    traceCode = TclCheckInterpTraces(interp, command, length,
-		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
-	}
-    }
-    Tcl_DecrRefCount(commandPtr);
 
-    /*
-     * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
-     * Prevent that by resetting the cmdPtr field and dealing right here with
-     * cmdPtr->refCount.
-     */
-
-    TclCleanupCommandMacro(cmdPtr);
+	/*
+	 * Release the temp table we used to collect the locations of
+	 * continuation lines, if any.
+	 */
 
-    if (traceCode != TCL_OK) {
-	return traceCode;
+	if (maxNumCL) {
+	    ckfree ((char*) clPosition);
+	}
+#endif
+    } else {
+	code = TCL_ERROR;
     }
-    return result;
-}
 
-static inline Command *
-TEOV_LookupCmdFromObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *namePtr,
-    Namespace *lookupNsPtr)
-{
-    Interp *iPtr = (Interp *) interp;
-    Command *cmdPtr;
-    Namespace *savedNsPtr = iPtr->varFramePtr->nsPtr;
-
-    if (lookupNsPtr) {
-	iPtr->varFramePtr->nsPtr = lookupNsPtr;
-	iPtr->lookupNsPtr = NULL;
+    done:
+    if (resultPtr != NULL) {
+	Tcl_DecrRefCount(resultPtr);
     }
-    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
-    iPtr->varFramePtr->nsPtr = savedNsPtr;
-    return cmdPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * 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 array of tokens being evaled.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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. */
-{
-    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
-	    NULL, NULL);
+    return code;
 }
 
 /*
@@ -4835,62 +3850,67 @@ Tcl_EvalTokensStandard(
  *
  * 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 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 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(
-    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(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.
 				 * Must be at least 1. */
 {
+    int code;
     Tcl_Obj *resPtr;
-
-    if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
+    
+    code = Tcl_EvalTokensStandard(interp, tokenPtr, count);
+    if (code == TCL_OK) {
+	resPtr = Tcl_GetObjResult(interp);
+	Tcl_IncrRefCount(resPtr);
+	Tcl_ResetResult(interp);
+	return resPtr;
+    } else {
 	return NULL;
     }
-    resPtr = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(resPtr);
-    Tcl_ResetResult(interp);
-    return resPtr;
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_EvalEx, TclEvalEx --
+ * Tcl_EvalEx, EvalEx --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -4900,81 +3920,87 @@ Tcl_EvalTokens(
  */
 
 int
-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
+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
 				 * 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. */
 {
-    return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
+#ifdef TCL_TIP280
+  return EvalEx (interp, script, numBytes, flags, 1, NULL, script);
 }
 
-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
+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
 				 * script consists of all bytes up to the
-				 * 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 '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 the outer-most script/command. See
-				 * Tcl_EvalEx() and TclEvalObjEx() for places
-				 * generating arguments for which this is
-				 * true. */
+				 * 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
+			      * [...]-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 the outer-most script/command. See
+			      * Tcl_EvalEx() and TclEvalObjEx() for places
+			      * generating arguments for which this is true.
+			      */
 {
+#endif
     Interp *iPtr = (Interp *) interp;
-    const char *p, *next;
-    const unsigned int minObjs = 20;
-    Tcl_Obj **objv, **objvSpace;
-    int *expand, *lines, *lineSpace;
+    CONST char *p, *next;
+    Tcl_Parse parse;
+#define NUM_STATIC_OBJS 20
+    Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
     Tcl_Token *tokenPtr;
-    int commandLength, bytesLeft, expandRequested, code = TCL_OK;
-    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
-				 * TCL_EVAL_GLOBAL was set. */
+    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 allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
-    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 = TclStackAlloc(interp, sizeof(Tcl_Parse));
-    CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
-    Tcl_Obj **stackObjArray =
-	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
-    int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int));
-    int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int));
-				/* TIP #280 Structures for tracking of command
-				 * locations. */
-    int *clNext = NULL;		/* Pointer for the tracking of invisible
-				 * continuation lines. Initialized only if the
-				 * caller gave us a table of locations to
-				 * track, via scriptCLLocPtr. It always refers
-				 * to the table entry holding the location of
-				 * the next invisible continuation line to
-				 * look for, while parsing the script. */
+    
+    /*
+     * 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;
+
+    /*
+     * Pointer for the tracking of invisible continuation lines. Initialized
+     * only if the caller gave us a table of locations to track, via
+     * scriptCLLocPtr. It always refers to the table entry holding the
+     * location of the next invisible continuation line to look for, while
+     * parsing the script.
+     */
+
+    int* clNext = NULL;
 
     if (iPtr->scriptCLLocPtr) {
 	if (clNextOuter) {
@@ -4983,6 +4009,7 @@ TclEvalEx(
 	    clNext = &iPtr->scriptCLLocPtr->loc[0];
 	}
     }
+#endif
 
     if (numBytes < 0) {
 	numBytes = strlen(script);
@@ -4991,105 +4018,112 @@ TclEvalEx(
 
     savedVarFramePtr = iPtr->varFramePtr;
     if (flags & TCL_EVAL_GLOBAL) {
-	iPtr->varFramePtr = iPtr->rootFramePtr;
+	iPtr->varFramePtr = NULL;
     }
 
     /*
-     * 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 = objvSpace = stackObjArray;
-    lines = lineSpace = linesStack;
-    expand = expandStack;
+    objv = staticObjArray;
     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. */
     /*
-     * 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.
-     */
-
-    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
-    eeFramePtr->numLevels = iPtr->numLevels;
-    eeFramePtr->framePtr = iPtr->framePtr;
-    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
-    eeFramePtr->nline = 0;
-    eeFramePtr->line = NULL;
-
-    iPtr->cmdFramePtr = eeFramePtr;
+     * 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.
+     */
+
     if (iPtr->evalFlags & TCL_EVAL_CTX) {
-	/*
-	 * Path information comes out of the context.
-	 */
+        /* Path information comes out of the context. */
 
-	eeFramePtr->type = TCL_LOCATION_SOURCE;
-	eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
-	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
+        eeFrame.type           = TCL_LOCATION_SOURCE;
+	eeFrame.data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
+	Tcl_IncrRefCount (eeFrame.data.eval.path);
     } else if (iPtr->evalFlags & TCL_EVAL_FILE) {
-	/*
-	 * Set up for a sourced file.
-	 */
+	/* Set up for a sourced file */
 
-	eeFramePtr->type = TCL_LOCATION_SOURCE;
+        eeFrame.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 == NULL) {
-		/*
-		 * Error message in the interp result.
-		 */
-
-		code = TCL_ERROR;
-		goto error;
+	    Tcl_Obj* norm = Tcl_FSGetNormalizedPath (interp, iPtr->scriptFile);
+	    if (!norm) {
+		/* Error message in the interp result */
+		return TCL_ERROR;
 	    }
-	    eeFramePtr->data.eval.path = norm;
+	    eeFrame.data.eval.path = norm;
 	} else {
-	    TclNewLiteralStringObj(eeFramePtr->data.eval.path, "");
+	    eeFrame.data.eval.path = Tcl_NewStringObj ("",-1);
 	}
-	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
+	Tcl_IncrRefCount (eeFrame.data.eval.path);
     } else {
-	/*
-	 * Set up for plain eval.
-	 */
+	/* Set up for plain eval */
 
-	eeFramePtr->type = TCL_LOCATION_EVAL;
-	eeFramePtr->data.eval.path = NULL;
+	eeFrame.type           = TCL_LOCATION_EVAL;
+	eeFrame.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
+
     iPtr->evalFlags = 0;
     do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
+	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse)
+	        != 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 to count the lines in this
+	 * found the command we are now at. We have count the lines in this
 	 * block, and do not forget invisible continuation lines.
 	 */
 
-	TclAdvanceLines(&line, p, parsePtr->commandStart);
-	TclAdvanceContinuations(&line, &clNext,
-		parsePtr->commandStart - outerScript);
+	TclAdvanceLines         (&line, p, parse.commandStart);
+	TclAdvanceContinuations (&line, &clNext,
+				 parse.commandStart - outerScript);
+#endif
 
-	gotParse = 1;
-	if (parsePtr->numWords > 0) {
+	if (parse.numWords > 0) {
+#ifdef TCL_TIP280
 	    /*
 	     * TIP #280. Track lines within the words of the current
 	     * command. We use a separate pointer into the table of
@@ -5097,140 +4131,77 @@ TclEvalEx(
 	     * per-command parsing.
 	     */
 
-	    int wordLine = line;
-	    const char *wordStart = parsePtr->commandStart;
-	    int *wordCLNext = clNext;
-	    unsigned int objectsNeeded = 0;
-	    unsigned int numWords = parsePtr->numWords;
+	    int         wordLine   = line;
+	    CONST char* wordStart  = parse.commandStart;
+	    int*        wordCLNext = clNext;
+#endif
 
 	    /*
 	     * Generate an array of objects for the words of the command.
 	     */
-
-	    if (numWords > minObjs) {
-		expand =    ckalloc(numWords * sizeof(int));
-		objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *));
-		lineSpace = ckalloc(numWords * sizeof(int));
+    
+	    if (parse.numWords <= NUM_STATIC_OBJS) {
+		objv = staticObjArray;
+	    } else {
+		objv = (Tcl_Obj **) ckalloc((unsigned)
+		    (parse.numWords * sizeof (Tcl_Obj *)));
 	    }
-	    expandRequested = 0;
-	    objv = objvSpace;
-	    lines = lineSpace;
-
-	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
-	    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).
+
+#ifdef TCL_TIP280
+	    eeFrame.nline = parse.numWords;
+	    eeFrame.line  = (int*) ckalloc((unsigned)
+		  (parse.numWords * sizeof (int)));
+#endif
+
+	    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).
 		 */
 
-		TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
-		TclAdvanceContinuations(&wordLine, &wordCLNext,
-			tokenPtr->start - outerScript);
+		TclAdvanceLines         (&wordLine, wordStart, tokenPtr->start);
+		TclAdvanceContinuations (&wordLine, &wordCLNext,
+					 tokenPtr->start - outerScript);
 		wordStart = tokenPtr->start;
 
-		lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
-			? wordLine : -1;
+		eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr)
+					      ? wordLine
+					      : -1);
 
-		if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
+	        if (eeFrame.type == TCL_LOCATION_SOURCE) {
 		    iPtr->evalFlags |= TCL_EVAL_FILE;
 		}
 
-		code = TclSubstTokens(interp, tokenPtr+1,
-			tokenPtr->numComponents, NULL, wordLine,
-			wordCLNext, outerScript);
+		code = EvalTokensStandard(interp, tokenPtr+1, 
+		            tokenPtr->numComponents, wordLine,
+			    wordCLNext, outerScript);
 
 		iPtr->evalFlags = 0;
+#endif
 
-		if (code != TCL_OK) {
-		    break;
-		}
-		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]);
-			break;
+		if (code == TCL_OK) {
+		    objv[objectsUsed] = Tcl_GetObjResult(interp);
+		    Tcl_IncrRefCount(objv[objectsUsed]);
+#ifdef TCL_TIP280
+		    if (wordCLNext) {
+			TclContinuationsEnterDerived (objv[objectsUsed],
+				      wordStart - outerScript, wordCLNext);
 		    }
-		    expandRequested = 1;
-		    expand[objectsUsed] = 1;
-
-		    objectsNeeded += (numElements ? numElements : 1);
+#endif
 		} else {
-		    expand[objectsUsed] = 0;
-		    objectsNeeded++;
-		}
-
-		if (wordCLNext) {
-		    TclContinuationsEnterDerived(objv[objectsUsed],
-			    wordStart - outerScript, wordCLNext);
-		}
-	    } /* for loop */
-	    iPtr->cmdFramePtr = eeFramePtr;
-	    if (code != TCL_OK) {
-		goto error;
-	    }
-	    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 =
-			    ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
-		    lines = lineSpace = 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(copy);
-		}
-		if (lcopy != linesStack) {
-		    ckfree(lcopy);
+		    goto error;
 		}
 	    }
-
+    
 	    /*
 	     * Execute the command and free the objects for its words.
 	     *
@@ -5241,23 +4212,29 @@ TclEvalEx(
 	     * have been executed.
 	     */
 
-	    eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
-	    eeFramePtr->cmd.str.len = parsePtr->commandSize;
+#ifdef TCL_TIP280
+	    eeFrame.cmd.str.cmd = parse.commandStart;
+	    eeFrame.cmd.str.len = parse.commandSize;
 
-	    if (parsePtr->term ==
-		    parsePtr->commandStart + parsePtr->commandSize - 1) {
-		eeFramePtr->cmd.str.len--;
+	    if (parse.term == parse.commandStart + parse.commandSize - 1) {
+		eeFrame.cmd.str.len --;
 	    }
 
-	    eeFramePtr->nline = objectsUsed;
-	    eeFramePtr->line = lines;
-
-	    TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr);
-	    code = Tcl_EvalObjv(interp, objectsUsed, objv, TCL_EVAL_NOERR);
-	    TclArgumentRelease(interp, objv, objectsUsed);
-
-	    eeFramePtr->line = NULL;
-	    eeFramePtr->nline = 0;
+	    TclArgumentEnter (interp, objv, objectsUsed, &eeFrame);
+	    iPtr->cmdFramePtr = &eeFrame;
+#endif
+	    iPtr->numLevels++;    
+	    code = TclEvalObjvInternal(interp, objectsUsed, objv, 
+	            parse.commandStart, parse.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
 
 	    if (code != TCL_OK) {
 		goto error;
@@ -5266,21 +4243,9 @@ TclEvalEx(
 		Tcl_DecrRefCount(objv[i]);
 	    }
 	    objectsUsed = 0;
-	    if (objvSpace != stackObjArray) {
-		ckfree(objvSpace);
-		objvSpace = stackObjArray;
-		ckfree(lineSpace);
-		lineSpace = linesStack;
-	    }
-
-	    /*
-	     * Free expand separately since objvSpace could have been
-	     * reallocated above.
-	     */
-
-	    if (expand != expandStack) {
-		ckfree(expand);
-		expand = expandStack;
+	    if (objv != staticObjArray) {
+		ckfree((char *) objv);
+		objv = staticObjArray;
 	    }
 	}
 
@@ -5291,92 +4256,214 @@ TclEvalEx(
 	 * executed command.
 	 */
 
-	next = parsePtr->commandStart + parsePtr->commandSize;
+	next = parse.commandStart + parse.commandSize;
 	bytesLeft -= next - p;
 	p = next;
-	TclAdvanceLines(&line, parsePtr->commandStart, p);
-	Tcl_FreeParse(parsePtr);
+#ifdef TCL_TIP280
+	TclAdvanceLines (&line, parse.commandStart, p);
+#endif
+	Tcl_FreeParse(&parse);
 	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 and log various pieces of error information.
+     * 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.
      */
 
     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 = parsePtr->commandSize;
-	if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
+    if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { 
+	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;
 	}
-	Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
-		commandLength);
+	Tcl_LogCommandInfo(interp, script, parse.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(parsePtr);
-    }
-    if (objvSpace != stackObjArray) {
-	ckfree(objvSpace);
-	ckfree(lineSpace);
+	Tcl_FreeParse(&parse);
     }
-    if (expand != expandStack) {
-	ckfree(expand);
+    if (objv != staticObjArray) {
+	ckfree((char *) objv);
     }
     iPtr->varFramePtr = savedVarFramePtr;
 
- cleanup_return:
     /*
-     * TIP #280. Release the local CmdFrame, and its contents.
+     * 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
+    }
+
+    /*
+     * 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.
      */
 
-    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
-    if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
-	Tcl_DecrRefCount(eeFramePtr->data.eval.path);
+    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;
     }
-    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 function is a helper which counts the number of lines in a block
- *	of text and advances an external counter.
+ *	This procedure is a helper which counts the number of lines
+ *	in a block of text and advances an external counter.
  *
  * Results:
  *	None.
@@ -5389,16 +4476,15 @@ TclEvalEx(
  */
 
 void
-TclAdvanceLines(
-    int *line,
-    const char *start,
-    const char *end)
+TclAdvanceLines (line,start,end)
+     int*        line;
+     CONST char* start;
+     CONST char* end;
 {
-    register const char *p;
-
+    CONST char* p;
     for (p = start; p < end; p++) {
-	if (*p == '\n') {
-	    (*line)++;
+        if (*p == '\n') {
+	  (*line) ++;
 	}
     }
 }
@@ -5424,31 +4510,29 @@ TclAdvanceLines(
  */
 
 void
-TclAdvanceContinuations(
-    int *line,
-    int **clNextPtrPtr,
-    int loc)
+TclAdvanceContinuations (line,clNextPtrPtr,loc)
+     int* line;
+     int** clNextPtrPtr;
+     int loc;
 {
     /*
-     * Track the invisible continuation lines embedded in a script, if any.
-     * Here they are just spaces (already). They were removed by
-     * TclSubstTokens via TclParseBackslash.
+     * Track the invisible continuation lines embedded in a script, if
+     * any. Here they are just spaces (already). They were removed by
+     * EvalTokensStandard() 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)) {
+    while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) {
 	/*
 	 * We just stepped over an invisible continuation line. Adjust the
 	 * line counter and step to the table entry holding the location of
 	 * the next continuation line to track.
 	 */
-
-	(*line)++;
-	(*clNextPtrPtr)++;
+	(*line) ++;
+	(*clNextPtrPtr) ++;
     }
 }
 
@@ -5466,8 +4550,8 @@ TclAdvanceContinuations(
  *
  * TclArgumentEnter --
  *
- *	This procedure is a helper for the TIP #280 uplevel extension. It
- *	enters location references for the arguments of a command to be
+ *	This procedure is a helper for the TIP #280 uplevel extension.
+ *	It enters location references for the arguments of a command to be
  *	invoked. Only the first entry has the actual data, further entries
  *	simply count the usage up.
  *
@@ -5482,49 +4566,45 @@ TclAdvanceContinuations(
  */
 
 void
-TclArgumentEnter(
-    Tcl_Interp *interp,
-    Tcl_Obj **objv,
-    int objc,
-    CmdFrame *cfPtr)
+TclArgumentEnter(interp,objv,objc,cfPtr)
+     Tcl_Interp* interp;
+     Tcl_Obj**   objv;
+     int         objc;
+     CmdFrame*   cfPtr;
 {
-    Interp *iPtr = (Interp *) interp;
+    Interp* iPtr = (Interp*) interp;
     int new, i;
-    Tcl_HashEntry *hPtr;
-    CFWord *cfwPtr;
+    Tcl_HashEntry* hPtr;
+    CFWord* cfwPtr;
 
-    for (i = 1; i < objc; i++) {
+    for (i=1; i < objc; i++) {
 	/*
-	 * Ignore argument words without line information (= dynamic). If they
-	 * are variables they may have location information associated with
-	 * that, either through globally recorded 'set' invokations, or
+	 * Ignore argument words without line information (= dynamic).  If
+	 * they are variables they may have location information associated
+	 * with that, either through globally recorded 'set' invokations, or
 	 * literals in bytecode. Eitehr way there is no need to record
 	 * something here.
 	 */
 
-	if (cfPtr->line[i] < 0) {
-	    continue;
-	}
-	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &new);
+	if (cfPtr->line [i] < 0) continue;
+	hPtr = Tcl_CreateHashEntry (iPtr->lineLAPtr, (char*) objv[i], &new);
 	if (new) {
-	    /*
-	     * The word is not on the stack yet, remember the current location
-	     * and initialize references.
-	     */
-
-	    cfwPtr = ckalloc(sizeof(CFWord));
-	    cfwPtr->framePtr = cfPtr;
-	    cfwPtr->word = i;
-	    cfwPtr->refCount = 1;
-	    Tcl_SetHashValue(hPtr, cfwPtr);
+           /*
+	    * The word is not on the stack yet, remember the current location
+	    * and initialize references.
+            */
+           cfwPtr = (CFWord*) ckalloc (sizeof (CFWord));
+           cfwPtr->framePtr = cfPtr;
+           cfwPtr->word     = i;
+           cfwPtr->refCount = 1;
+           Tcl_SetHashValue (hPtr, cfwPtr);
 	} else {
-	    /*
-	     * The word is already on the stack, its current location is not
-	     * relevant. Just remember the reference to prevent early removal.
-	     */
-
-	    cfwPtr = Tcl_GetHashValue(hPtr);
-	    cfwPtr->refCount++;
+           /*
+	    * The word is already on the stack, its current location is not
+            * relevant. Just remember the reference to prevent early removal.
+            */
+           cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+           cfwPtr->refCount ++;
 	}
     }
 }
@@ -5534,10 +4614,10 @@ TclArgumentEnter(
  *
  * TclArgumentRelease --
  *
- *	This procedure is a helper for the TIP #280 uplevel extension. It
- *	removes the location references for the arguments of a command just
- *	done. Usage is counted down, the data is removed only when no user is
- *	left over.
+ *	This procedure is a helper for the TIP #280 uplevel extension.
+ *	It removes the location references for the arguments of a command
+ *	just done. Usage is counted down, the data is removed only when
+ *	no user is left over.
  *
  * Results:
  *	None.
@@ -5550,31 +4630,27 @@ TclArgumentEnter(
  */
 
 void
-TclArgumentRelease(
-    Tcl_Interp *interp,
-    Tcl_Obj **objv,
-    int objc)
-{
-    Interp *iPtr = (Interp *) interp;
+TclArgumentRelease(interp,objv,objc)
+     Tcl_Interp* interp;
+     Tcl_Obj**   objv;
+     int         objc;
+{
+    Interp*        iPtr = (Interp*) interp;
+    Tcl_HashEntry* hPtr;
+    CFWord*        cfwPtr;
     int i;
 
-    for (i = 1; i < objc; i++) {
-	CFWord *cfwPtr;
-	Tcl_HashEntry *hPtr =
-		Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);
+    for (i=1; i < objc; i++) {
+       hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) objv[i]);
 
-	if (!hPtr) {
-	    continue;
-	}
-	cfwPtr = Tcl_GetHashValue(hPtr);
+       if (!hPtr) { continue; }
+       cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
 
-	cfwPtr->refCount--;
-	if (cfwPtr->refCount > 0) {
-	    continue;
-	}
+       cfwPtr->refCount --;
+       if (cfwPtr->refCount > 0) { continue; }
 
-	ckfree(cfwPtr);
-	Tcl_DeleteHashEntry(hPtr);
+       ckfree ((char*) cfwPtr);
+       Tcl_DeleteHashEntry (hPtr);
     }
 }
 
@@ -5583,9 +4659,9 @@ TclArgumentRelease(
  *
  * TclArgumentBCEnter --
  *
- *	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 invoked. Only the first entry has the actual
+ *	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
  *	data, further entries simply count the usage up.
  *
  * Results:
@@ -5599,81 +4675,68 @@ TclArgumentRelease(
  */
 
 void
-TclArgumentBCEnter(
-    Tcl_Interp *interp,
-    Tcl_Obj *objv[],
-    int objc,
-    void *codePtr,
-    CmdFrame *cfPtr,
-    int pc)
+TclArgumentBCEnter(interp, objv, objc, codePtr, cfPtr, pc)
+     Tcl_Interp* interp;
+     Tcl_Obj*    objv[];
+     int         objc;
+     void*       codePtr;
+     CmdFrame*   cfPtr;
+     int         pc;
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hePtr =
-	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
-    ExtCmdLoc *eclPtr;
+    Interp*        iPtr  = (Interp*) interp;
+    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
 
-    if (!hePtr) {
-	return;
-    }
-    eclPtr = Tcl_GetHashValue(hePtr);
-    hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
     if (hePtr) {
-	int word;
-	int cmd = PTR2INT(Tcl_GetHashValue(hePtr));
-	ECL *ePtr = &eclPtr->loc[cmd];
-	CFWordBC *lastPtr = NULL;
+	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, (char*) pc);
 
-	/*
-	 * A few truths ...
-	 * (1) ePtr->nline == objc
-	 * (2) (ePtr->line[word] < 0) => !literal, for all words
-	 * (3) (word == 0) => !literal
-	 *
-	 * Item (2) is why we can use objv to get the literals, and do not
-	 * have to save them at compile time.
-	 */
+	if (hePtr) {
+	    int  word;
+	    int  cmd  = (int) Tcl_GetHashValue(hePtr);
+	    ECL* ePtr = &eclPtr->loc[cmd];
 
-        if (ePtr->nline != objc) {
-            Tcl_Panic ("TIP 280 data structure inconsistency");
-        }
-
-	for (word = 1; word < objc; word++) {
-	    if (ePtr->line[word] >= 0) {
-		int isnew;
-		Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
-			objv[word], &isnew);
-		CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC));
-
-		cfwPtr->framePtr = cfPtr;
-		cfwPtr->obj = objv[word];
-		cfwPtr->pc = pc;
-		cfwPtr->word = word;
-		cfwPtr->nextPtr = lastPtr;
-		lastPtr = cfwPtr;
-
-		if (isnew) {
-		    /*
-		     * The word is not on the stack yet, remember the current
-		     * location and initialize references.
-		     */
+	    /*
+	     * A few truths ...
+	     * (1) ePtr->nline == objc
+	     * (2) (ePtr->line[word] < 0) => !literal, for all words
+	     * (3) (word == 0) => !literal
+	     *
+	     * Item (2) is why we can use objv to get the literals, and do not
+	     * have to save them at compile time.
+	     */
 
-		    cfwPtr->prevPtr = NULL;
-		} else {
-		    /*
-		     * The object is already on the stack, however it may have
-		     * a different location now (literal sharing may map
-		     * multiple location to a single Tcl_Obj*. Save the old
-		     * information in the new structure.
-		     */
+	    for (word = 1; word < objc; word++) {
+		if (ePtr->line[word] >= 0) {
+		    int isnew;
+		    Tcl_HashEntry* hPtr =
+			Tcl_CreateHashEntry (iPtr->lineLABCPtr,
+					     (char*) objv[word], &isnew);
+		    CFWordBC* cfwPtr = (CFWordBC*) ckalloc (sizeof (CFWordBC));
 
-		    cfwPtr->prevPtr = Tcl_GetHashValue(hPtr);
-		}
+		    cfwPtr->framePtr = cfPtr;
+		    cfwPtr->pc       = pc;
+		    cfwPtr->word     = word;
 
-		Tcl_SetHashValue(hPtr, cfwPtr);
-	    }
-	} /* for */
+		    if (isnew) {
+			/*
+			 * The word is not on the stack yet, remember the
+			 * current location and initialize references.
+			 */
+			cfwPtr->prevPtr = NULL;
+		    } else {
+			/*
+			 * The object is already on the stack, however it may
+			 * have a different location now (literal sharing may
+			 * map multiple location to a single Tcl_Obj*. Save
+			 * the old information in the new structure.
+			 */
+			cfwPtr->prevPtr = (CFWordBC*) Tcl_GetHashValue(hPtr);
+		    }
 
-	cfPtr->litarg = lastPtr;
+		    Tcl_SetHashValue (hPtr, cfwPtr);
+		}
+	    } /* for */
+	} /* if */
     } /* if */
 }
 
@@ -5682,10 +4745,10 @@ TclArgumentBCEnter(
  *
  * TclArgumentBCRelease --
  *
- *	This procedure is a helper for the TIP #280 uplevel extension. It
- *	removes the location references for the literal arguments of commands
- *	in bytecode just done. Usage is counted down, the data is removed only
- *	when no user is left over.
+ *	This procedure is a helper for the TIP #280 uplevel extension.
+ *	It removes the location references for the literal arguments of
+ *	commands in bytecode just done. Usage is counted down, the data
+ *	is removed only when no user is left over.
  *
  * Results:
  *	None.
@@ -5698,34 +4761,48 @@ TclArgumentBCEnter(
  */
 
 void
-TclArgumentBCRelease(
-    Tcl_Interp *interp,
-    CmdFrame *cfPtr)
+TclArgumentBCRelease(interp, objv, objc, codePtr, pc)
+     Tcl_Interp* interp;
+     Tcl_Obj*    objv[];
+     int         objc;
+     void*       codePtr;
+     int         pc;
 {
-    Interp *iPtr = (Interp *) interp;
-    CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg;
+    Interp*        iPtr  = (Interp*) interp;
+    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
 
-    while (cfwPtr) {
-	CFWordBC *nextPtr = cfwPtr->nextPtr;
-	Tcl_HashEntry *hPtr =
-		Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
-	CFWordBC *xPtr = Tcl_GetHashValue(hPtr);
+    if (hePtr) {
+	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, (char*) pc);
 
-	if (xPtr != cfwPtr) {
-	    Tcl_Panic("TclArgumentBC Enter/Release Mismatch");
-	}
+	if (hePtr) {
+	    int  cmd  = (int) Tcl_GetHashValue(hePtr);
+	    ECL* ePtr = &eclPtr->loc[cmd];
+	    int word;
 
-	if (cfwPtr->prevPtr) {
-	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
-	} else {
-	    Tcl_DeleteHashEntry(hPtr);
-	}
+	    /*
+	     * Iterate in reverse order, to properly match our pop to the push
+	     * in TclArgumentBCEnter().
+	     */
+	    for (word = objc-1; word >= 1; word--) {
+		if (ePtr->line[word] >= 0) {
+		    Tcl_HashEntry* hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr,
+						    (char *) objv[word]);
+		    if (hPtr) {
+			CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
+ 
+			if (cfwPtr->prevPtr) {
+			    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
+			} else {
+			    Tcl_DeleteHashEntry(hPtr);
+			}
 
-	ckfree(cfwPtr);
-	cfwPtr = nextPtr;
+			ckfree((char *) cfwPtr);
+		    }
+		}
+	    }
+	}
     }
-
-    cfPtr->litarg = NULL;
 }
 
 /*
@@ -5733,8 +4810,8 @@ TclArgumentBCRelease(
  *
  * TclArgumentGet --
  *
- *	This procedure is a helper for the TIP #280 uplevel extension. It
- *	finds the location references for a Tcl_Obj, if any.
+ *	This procedure is a helper for the TIP #280 uplevel extension.
+ *	It find the location references for a Tcl_Obj, if any.
  *
  * Results:
  *	None.
@@ -5747,37 +4824,36 @@ TclArgumentBCRelease(
  */
 
 void
-TclArgumentGet(
-    Tcl_Interp *interp,
-    Tcl_Obj *obj,
-    CmdFrame **cfPtrPtr,
-    int *wordPtr)
+TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
+     Tcl_Interp* interp;
+     Tcl_Obj*    obj;
+     CmdFrame**  cfPtrPtr;
+     int*        wordPtr;
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hPtr;
-    CmdFrame *framePtr;
+    Interp*        iPtr = (Interp*) interp;
+    Tcl_HashEntry* hPtr;
+    CmdFrame*      framePtr;
 
     /*
-     * 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.
+     * 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.
      */
 
-    if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
+    if (!obj->bytes) {
 	return;
     }
-
+    
     /*
      * First look for location information recorded in the argument
      * stack. That is nearest.
      */
 
-    hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj);
+    hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) obj);
     if (hPtr) {
-	CFWord *cfwPtr = Tcl_GetHashValue(hPtr);
-
-	*wordPtr = cfwPtr->word;
+	CFWord* cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+	*wordPtr  = cfwPtr->word;
 	*cfPtrPtr = cfwPtr->framePtr;
 	return;
     }
@@ -5787,34 +4863,37 @@ TclArgumentGet(
      * that stack.
      */
 
-    hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
+    hPtr = Tcl_FindHashEntry (iPtr->lineLABCPtr, (char *) obj);
     if (hPtr) {
-	CFWordBC *cfwPtr = Tcl_GetHashValue(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;
+	*wordPtr  = cfwPtr->word;
 	return;
     }
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_Eval --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -5823,20 +4902,21 @@ TclArgumentGet(
  */
 
 int
-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. */
+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. */
 {
-    int code = Tcl_EvalEx(interp, script, -1, 0);
+    int code = Tcl_EvalEx(interp, string, -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).
      */
 
-    (void) Tcl_GetStringResult(interp);
+    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	    TCL_VOLATILE);
     return code;
 }
 
@@ -5859,17 +4939,18 @@ Tcl_Eval(
 
 #undef Tcl_EvalObj
 int
-Tcl_EvalObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr)
+Tcl_EvalObj(interp, objPtr)
+    Tcl_Interp * interp;
+    Tcl_Obj * objPtr;
 {
     return Tcl_EvalObjEx(interp, objPtr, 0);
 }
+
 #undef Tcl_GlobalEvalObj
 int
-Tcl_GlobalEvalObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr)
+Tcl_GlobalEvalObj(interp, objPtr)
+    Tcl_Interp * interp;
+    Tcl_Obj * objPtr;
 {
     return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
 }
@@ -5880,418 +4961,367 @@ Tcl_GlobalEvalObj(
  * 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.
+ *	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.
  *
  * TIP #280 : Keep public API, internally extended API.
  *----------------------------------------------------------------------
  */
 
 int
-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. */
-{
-    return TclEvalObjEx(interp, objPtr, flags, NULL, 0);
+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. */
+{
+#ifdef TCL_TIP280
+  return TclEvalObjEx (interp, objPtr, flags, NULL, 0);
 }
 
 int
-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. */
+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 */
 {
-    int result = TCL_OK;
-    NRE_callback *rootPtr = TOP_CB(interp);
-
-    result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
-    return TclNRRunCallbacks(interp, result, rootPtr);
-}
-
-int
-TclNREvalObjEx(
-    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. */
-{
-    Interp *iPtr = (Interp *) interp;
+#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);
 
-    /*
-     * This function consists of three independent blocks for: direct
-     * evaluation of canonical lists, compilation and bytecode execution and
-     * finally direct evaluation. Precisely one of these blocks will be run.
-     */
-
-    if (TclListObjIsCanonical(objPtr)) {
-	Tcl_Obj *listPtr = objPtr;
-	CmdFrame *eoFramePtr = NULL;
-	int objc;
-	Tcl_Obj **objv;
+    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.
+	 * We're not supposed to use the compiler or byte-code interpreter.
+	 * Let Tcl_EvalEx evaluate the command directly (and probably
+	 * more slowly).
 	 *
-	 * This also preserves any associations between list elements and
-	 * location information for such elements.
+	 * 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 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).
+	 * USE_EVAL_DIRECT is a special flag used for testing purpose only
+	 * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
 	 */
+	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.
+	     */
 
-	/*
-	 * Shimmer protection! Always pass an unshared obj. The caller could
-	 * incr the refCount of objPtr AFTER calling us! To be completely safe
-	 * we always make a copy. The callback takes care od the refCounts for
-	 * both listPtr and objPtr.
-	 *
-	 * FIXME OPT: preserve just the internal rep?
-	 */
-
-	Tcl_IncrRefCount(objPtr);
-	listPtr = TclListObjCopy(interp, objPtr);
-	Tcl_IncrRefCount(listPtr);
-	TclDecrRefCount(objPtr);
-
-	if (word != INT_MIN) {
+	    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
 	    /*
-	     * TIP #280 Structures for tracking lines. As we know that this is
-	     * dynamic execution we ignore the invoker, even if known.
-	     *
-	     * 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.
+	     * Copy the list elements here, to avoid a segfault if
+	     * objPtr loses its List internal rep [Bug 1119369].
 	     *
-	     * Note that we use (word==INTMIN) to signal that no command frame
-	     * should be pushed, as needed by alias and ensemble redirections.
+	     * 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.
 	     */
 
-	    eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
-	    eoFramePtr->nline = 0;
-	    eoFramePtr->line = NULL;
-
-	    eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
-	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
-		    1 : iPtr->cmdFramePtr->level + 1);
-	    eoFramePtr->numLevels = iPtr->numLevels;
-	    eoFramePtr->framePtr = iPtr->framePtr;
-	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
-
-	    eoFramePtr->cmd.listPtr = listPtr;
-	    eoFramePtr->data.eval.path = NULL;
-
-	    iPtr->cmdFramePtr = eoFramePtr;
-	}
-
-	TclNRDeferCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
-		NULL, NULL);
-
-	ListObjGetElements(listPtr, objc, objv);
-	return TclNREvalObjv(interp, objc, objv, flags, NULL);
-    }
-
-    if (!(flags & TCL_EVAL_DIRECT)) {
-	/*
-	 * 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.
-	 */
-
-	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
-	ByteCode *codePtr;
-	CallFrame *savedVarFramePtr = NULL;	/* Saves old copy of
-						 * iPtr->varFramePtr in case
-						 * TCL_EVAL_GLOBAL was set. */
-
-        if (TclInterpReady(interp) != TCL_OK) {
-            return TCL_ERROR;
-        }
-	if (flags & TCL_EVAL_GLOBAL) {
-	    savedVarFramePtr = iPtr->varFramePtr;
-	    iPtr->varFramePtr = iPtr->rootFramePtr;
-	}
-	Tcl_IncrRefCount(objPtr);
-	codePtr = TclCompileObj(interp, objPtr, invoker, word);
-
-	TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
-		objPtr, INT2PTR(allowExceptions), NULL);
-        return TclNRExecuteByteCode(interp, codePtr);
-    }
-
-    {
-	/*
-	 * We're not supposed to use the compiler or byte-code
-	 * interpreter. 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.
-	 */
-
-	const char *script;
-	int numSrcBytes;
-
-	/*
-	 * 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.
-	 */
+	    for (i=0; i < objc; i++) {
+		objv[i] = listRepPtr->elements[i];
+		Tcl_IncrRefCount(objv[i]);
+	    }
 
-	ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
-	ContLineLoc *clLocPtr = TclContinuationsGet(objPtr);
+#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 (clLocPtr) {
-	    iPtr->scriptCLLocPtr = clLocPtr;
-	    Tcl_Preserve(iPtr->scriptCLLocPtr);
+	    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 {
-	    iPtr->scriptCLLocPtr = NULL;
-	}
-
-	Tcl_IncrRefCount(objPtr);
-	if (invoker == NULL) {
-	    /*
-	     * No context, force opening of our own.
-	     */
-
+#ifndef TCL_TIP280
 	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 	    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
-	} else {
+#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.
+	     * 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.
 	     *
-	     * 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.
+	     * See also tclCompile.c, TclInitCompileEnv, for the equivalent
+	     * code in the bytecode compiler.
 	     */
 
-	    int pc = 0;
-	    CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+	    /*
+	     * 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.
+	     */
 
-	    *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.
-		 */
+	    ContLineLoc* saveCLLocPtr = iPtr->scriptCLLocPtr;
+	    ContLineLoc* clLocPtr = TclContinuationsGet (objPtr);
 
-		TclGetSrcInfoForPc(ctxPtr);
-		pc = 1;
+	    if (clLocPtr) {
+		iPtr->scriptCLLocPtr = clLocPtr;
+		Tcl_Preserve (iPtr->scriptCLLocPtr);
+	    } else {
+		iPtr->scriptCLLocPtr = NULL;
 	    }
 
-	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-
-	    if ((invoker->nline <= word) ||
-		    (invoker->line[word] < 0) ||
-		    (ctxPtr->type != TCL_LOCATION_SOURCE)) {
-		/*
-		 * Dynamic script, or dynamic context, force our own context.
-		 */
-
+	    if (invoker == NULL) {
+	        /* No context, force opening of our own */
+	        script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
 	    } else {
-		/*
-		 * Absolute context to reuse.
+		/* 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.
 		 */
 
-		iPtr->invokeCmdFramePtr = ctxPtr;
-		iPtr->evalFlags |= TCL_EVAL_CTX;
+		CmdFrame ctx = *invoker;
+		int pc       = 0;
+
+		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;
+		}
+
+                script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
 
-		result = TclEvalEx(interp, script, numSrcBytes, flags,
-			ctxPtr->line[word], NULL, script);
+		if ((ctx.nline <= word) ||
+		    (ctx.line[word] < 0) ||
+		    (ctx.type != TCL_LOCATION_SOURCE)) {
+		    /* Dynamic script, or dynamic context, force our own
+		     * context */
+
+		    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+		} else {
+		    /* Absolute context available to reuse. */
+
+		    iPtr->invokeCmdFramePtr = &ctx;
+		    iPtr->evalFlags |= TCL_EVAL_CTX;
+
+		    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);
+		}
 	    }
-	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
-		/*
-		 * Death of SrcInfo reference.
-		 */
 
-		Tcl_DecrRefCount(ctxPtr->data.eval.path);
+	    /*
+	     * Now release the lock on the continuation line information, if
+	     * any, and restore the caller's settings.
+	     */
+
+	    if (iPtr->scriptCLLocPtr) {
+		Tcl_Release (iPtr->scriptCLLocPtr);
 	    }
-	    TclStackFree(interp, ctxPtr);
+	    iPtr->scriptCLLocPtr = saveCLLocPtr;
+#endif
 	}
-
+    } else {
 	/*
-	 * Now release the lock on the continuation line information, if any,
-	 * and restore the caller's settings.
+	 * 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.
 	 */
 
-	if (iPtr->scriptCLLocPtr) {
-	    Tcl_Release(iPtr->scriptCLLocPtr);
-	}
-	iPtr->scriptCLLocPtr = saveCLLocPtr;
-	TclDecrRefCount(objPtr);
-	return result;
-    }
-}
-
-static int
-TEOEx_ByteCodeCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *savedVarFramePtr = data[0];
-    Tcl_Obj *objPtr = data[1];
-    int allowExceptions = PTR2INT(data[2]);
-
-    if (iPtr->numLevels == 0) {
-	if (result == TCL_RETURN) {
-	    result = TclUpdateReturnInfo(iPtr);
+	savedVarFramePtr = iPtr->varFramePtr;
+	if (flags & TCL_EVAL_GLOBAL) {
+	    iPtr->varFramePtr = NULL;
 	}
-	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
-	    const char *script;
-	    int numSrcBytes;
 
-	    ProcessUnexpectedResult(interp, result);
-	    result = TCL_ERROR;
-	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
-	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
-	}
+#ifndef TCL_TIP280
+	result = TclCompEvalObj(interp, objPtr);
+#else
+	result = TclCompEvalObj(interp, objPtr, invoker, word);
+#endif
 
 	/*
-	 * We are returning to level 0, so should call TclResetCancellation.
-	 * Let us just unset the flags inline.
+	 * 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) {
+		ProcessUnexpectedResult(interp, result);
+		result = TCL_ERROR;
 
-	TclUnsetCancelFlags(iPtr);
-    }
-    iPtr->evalFlags = 0;
-
-    /*
-     * Restore the callFrame if this was a TCL_EVAL_GLOBAL.
-     */
+		/*
+		 * 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 (savedVarFramePtr) {
-	iPtr->varFramePtr = savedVarFramePtr;
+		if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
+		    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+		    Tcl_LogCommandInfo(interp, script, script, --numSrcBytes);
+		    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+		}
+	    }
+	}
+	iPtr->evalFlags = 0;
+	iPtr->varFramePtr = savedVarFramePtr; 
     }
 
     TclDecrRefCount(objPtr);
     return result;
 }
-
-static int
-TEOEx_ListCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *listPtr = data[0];
-    CmdFrame *eoFramePtr = data[1];
-
-    /*
-     * Remove the cmdFrame
-     */
-
-    if (eoFramePtr) {
-	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
-	TclStackFree(interp, eoFramePtr);
-    }
-    TclDecrRefCount(listPtr);
-
-    return result;
-}
 
 /*
  *----------------------------------------------------------------------
  *
  * ProcessUnexpectedResult --
  *
- *	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.
+ *	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.
  *
  * 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(
-    Tcl_Interp *interp,		/* The interpreter in which the unexpected
+ProcessUnexpectedResult(interp, returnCode)
+    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. */
 {
-    char buf[TCL_INTEGER_SPACE];
-
     Tcl_ResetResult(interp);
     if (returnCode == TCL_BREAK) {
-	Tcl_AppendResult(interp,
-		"invoked \"break\" outside of a loop", NULL);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "invoked \"break\" outside of a loop", -1);
     } else if (returnCode == TCL_CONTINUE) {
-	Tcl_AppendResult(interp,
-		"invoked \"continue\" outside of a loop", NULL);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+		"invoked \"continue\" outside of a loop", -1);
     } else {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"command returned bad code: %d", returnCode));
+        char buf[30 + TCL_INTEGER_SPACE];
+
+	sprintf(buf, "command returned bad code: %d", returnCode);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     }
-    sprintf(buf, "%d", returnCode);
-    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
 }
 
 /*
@@ -6299,15 +5329,15 @@ ProcessUnexpectedResult(
  *
  * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
  *
- *	Functions to evaluate an expression and return its value in a
+ *	Procedures to evaluate an expression and return its value in a
  *	particular form.
  *
  * Results:
- *	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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -6316,92 +5346,197 @@ ProcessUnexpectedResult(
  */
 
 int
-Tcl_ExprLong(
-    Tcl_Interp *interp,		/* Context in which to evaluate the
+Tcl_ExprLong(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
 				 * expression. */
-    const char *exprstring,	/* Expression to evaluate. */
-    long *ptr)			/* Where to store result. */
+    CONST char *string;		/* 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 (*exprstring == '\0') {
-	/*
-	 * Legacy compatibility - return 0 for the zero-length string.
-	 */
 
-	*ptr = 0;
-    } else {
-	exprPtr = Tcl_NewStringObj(exprstring, -1);
+    if (length > 0) {
+	exprPtr = Tcl_NewStringObj(string, length);
 	Tcl_IncrRefCount(exprPtr);
-	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
-	Tcl_DecrRefCount(exprPtr);
-	if (result != TCL_OK) {
-	    (void) Tcl_GetStringResult(interp);
+	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 {
+	/*
+	 * An empty string. Just set the result integer to 0.
+	 */
+	
+	*ptr = 0;
     }
     return result;
 }
 
 int
-Tcl_ExprDouble(
-    Tcl_Interp *interp,		/* Context in which to evaluate the
+Tcl_ExprDouble(interp, string, ptr)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
 				 * expression. */
-    const char *exprstring,	/* Expression to evaluate. */
-    double *ptr)		/* Where to store result. */
+    CONST char *string;		/* 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 (*exprstring == '\0') {
+    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 {
 	/*
-	 * Legacy compatibility - return 0 for the zero-length string.
+	 * An empty string. Just set the result double to 0.0.
 	 */
-
+	
 	*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(
-    Tcl_Interp *interp,		/* Context in which to evaluate the
-				 * expression. */
-    const char *exprstring,	/* Expression to evaluate. */
-    int *ptr)			/* Where to store 0/1 result. */
+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. */
 {
-    if (*exprstring == '\0') {
-	/*
-	 * An empty string. Just set the result boolean to 0 (false).
-	 */
-
-	*ptr = 0;
-	return TCL_OK;
-    } else {
-	int result;
-	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);
+    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_ExprBooleanObj(interp, exprPtr, ptr);
-	Tcl_DecrRefCount(exprPtr);
+	result = Tcl_ExprObj(interp, exprPtr, &resultPtr);
+	if (result == TCL_OK) {
+	    /*
+	     * Store a boolean based on the expression result.
+	     */
+
+	    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 */
+	}
 	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.
 	     */
 
-	    (void) Tcl_GetStringResult(interp);
+	    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	            TCL_VOLATILE);
 	}
-	return result;
+	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the result boolean to 0 (false).
+	 */
+	
+	*ptr = 0;
     }
+    return result;
 }
 
 /*
@@ -6409,15 +5544,16 @@ Tcl_ExprBoolean(
  *
  * Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj --
  *
- *	Functions to evaluate an expression in an object and return its value
- *	in a particular form.
+ *	Procedures to evaluate an expression in an object and return its
+ *	value in a particular form.
  *
  * Results:
- *	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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -6426,104 +5562,79 @@ Tcl_ExprBoolean(
  */
 
 int
-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_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_Obj *resultPtr;
-    int result, type;
-    double d;
-    ClientData internalPtr;
+    int result;
 
     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
-    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;
+    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;
+	    }
 	}
-	resultPtr = Tcl_NewBignumObj(&big);
-	/* FALLTHROUGH */
+	Tcl_DecrRefCount(resultPtr);  /* discard the result object */
     }
-    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(
-    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(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_Obj *resultPtr;
-    int result, type;
-    ClientData internalPtr;
+    int result;
 
     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    result = TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type);
     if (result == TCL_OK) {
-	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:
+	if (resultPtr->typePtr == &tclIntType) {
+	    *ptr = (double) resultPtr->internalRep.longValue;
+	} else if (resultPtr->typePtr == &tclDoubleType) {
+	    *ptr = resultPtr->internalRep.doubleValue;
+	} else {
 	    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(
-    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(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_Obj *resultPtr;
     int result;
 
     result = Tcl_ExprObj(interp, objPtr, &resultPtr);
     if (result == TCL_OK) {
-	result = Tcl_GetBooleanFromObj(interp, resultPtr, ptr);
-	Tcl_DecrRefCount(resultPtr);
-				/* Discard the result object. */
+	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;
 }
@@ -6531,14 +5642,12 @@ Tcl_ExprBooleanObj(
 /*
  *----------------------------------------------------------------------
  *
- * TclObjInvokeNamespace --
+ * TclInvoke --
  *
- *	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 or namespace, thus it cannot see any current state on the
- *	stack of that interpreter.
+ *	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.
@@ -6550,2546 +5659,1141 @@ Tcl_ExprBooleanObj(
  */
 
 int
-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
-				 * name of the command to invoke. */
-    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. */
+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. */
 {
-    int result;
-    Tcl_CallFrame *framePtr;
+    register Tcl_Obj *objPtr;
+    register int i;
+    int length, result;
 
     /*
-     * Make the specified namespace the current namespace and invoke the
-     * command.
+     * 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.
      */
 
-    result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    result = TclObjInvoke(interp, objc, objv, flags);
-
-    TclPopStackFrame(interp);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclObjInvoke --
- *
- *	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.
- *
- * Side effects:
- *	Whatever the command does.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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
-				 * 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. */
-{
-    register Interp *iPtr = (Interp *) interp;
-    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
-    const char *cmdName;	/* Name of the command from objv[0]. */
-    Tcl_HashEntry *hPtr = NULL;
-    Command *cmdPtr;
-    int result;
-
-    if (interp == NULL) {
-	return TCL_ERROR;
-    }
+#define NUM_ARGS 20
+    Tcl_Obj *(objStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = objStorage;
 
-    if ((objc < 1) || (objv == NULL)) {
-	Tcl_AppendResult(interp, "illegal argument vector", NULL);
-	return TCL_ERROR;
-    }
-
-    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
-	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
-    }
+    /*
+     * 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 (TclInterpReady(interp) == TCL_ERROR) {
-	return TCL_ERROR;
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
     }
 
-    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);
-        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
-                NULL);
-	return TCL_ERROR;
+    for (i = 0;  i < argc;  i++) {
+	length = strlen(argv[i]);
+	objv[i] = Tcl_NewStringObj(argv[i], length);
+	Tcl_IncrRefCount(objv[i]);
     }
-    cmdPtr = Tcl_GetHashValue(hPtr);
+    objv[argc] = 0;
 
     /*
-     * Invoke the command function.
+     * Use TclObjInterpProc to actually invoke the command.
      */
 
-    iPtr->cmdCount++;
-    if (cmdPtr->objProc != NULL) {
-	result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
-    } else {
-	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
-		cmdPtr->objClientData, objc, objv);
-    }
+    result = TclObjInvoke(interp, argc, objv, flags);
 
     /*
-     * If an error occurred, record information about what was being executed
-     * when the error occurred.
+     * Move the interpreter's object result to the string result, 
+     * then reset the object result.
      */
+    
+    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	    TCL_VOLATILE);
 
-    if ((result == TCL_ERROR)
-	    && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
-	    && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
-	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;
-    }
-    return result;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * Tcl_ExprString --
- *
- *	Evaluate an expression in a string and return its value in string
- *	form.
- *
- * 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.
- *
- * 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.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-Tcl_ExprString(
-    Tcl_Interp *interp,		/* Context in which to evaluate the
-				 * expression. */
-    const char *expr)		/* Expression to evaluate. */
-{
-    int code = TCL_OK;
-
-    if (expr[0] == '\0') {
-	/*
-	 * An empty string. Just set the interpreter's result to 0.
-	 */
+    /*
+     * Decrement the ref counts on the objv elements since we are done
+     * with them.
+     */
 
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
-    } 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);
-	}
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	Tcl_DecrRefCount(objPtr);
     }
-
+    
     /*
-     * Force the string rep of the interp result.
+     * Free the objv array if malloc'ed storage was used.
      */
 
-    (void) Tcl_GetStringResult(interp);
-    return code;
+    if (objv != objStorage) {
+	ckfree((char *) objv);
+    }
+    return result;
+#undef NUM_ARGS
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AppendObjToErrorInfo --
+ * TclGlobalInvoke --
  *
- *	Add a Tcl_Obj value to the errorInfo field that describes the current
- *	error.
+ *	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:
- *	None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	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.
+ *	Whatever the command does.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_AppendObjToErrorInfo(
-    Tcl_Interp *interp,		/* Interpreter to which error information
-				 * pertains. */
-    Tcl_Obj *objPtr)		/* Message to record. */
+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. */
 {
-    int length;
-    const char *message = TclGetStringFromObj(objPtr, &length);
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
 
-    Tcl_IncrRefCount(objPtr);
-    Tcl_AddObjErrorInfo(interp, message, length);
-    Tcl_DecrRefCount(objPtr);
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = TclInvoke(interp, argc, argv, flags);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AddErrorInfo --
+ * TclObjInvokeGlobal --
  *
- *	Add information to the errorInfo field that describes the current
- *	error.
+ *	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
+ *	stack of that interpreter.
  *
  * Results:
- *	None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	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.
+ *	Whatever the command does.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_AddErrorInfo(
-    Tcl_Interp *interp,		/* Interpreter to which error information
-				 * pertains. */
-    const char *message)	/* Message to record. */
+int
+TclObjInvokeGlobal(interp, objc, objv, flags)
+    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
+				 * 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_AddObjErrorInfo(interp, message, -1);
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
+
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = TclObjInvoke(interp, objc, objv, flags);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AddObjErrorInfo --
+ * TclObjInvoke --
  *
- *	Add information to the errorInfo field that describes the current
- *	error. This routine differs from Tcl_AddErrorInfo by taking a byte
- *	pointer and length.
+ *	Invokes a Tcl command, given an objv/objc, from either the
+ *	exposed or the hidden sets of commands in the given interpreter.
  *
  * Results:
- *	None.
+ *	A standard Tcl object result.
  *
  * Side effects:
- *	"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.
+ *	Whatever the command does.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_AddObjErrorInfo(
-    Tcl_Interp *interp,		/* Interpreter to which error information
-				 * pertains. */
-    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
+TclObjInvoke(interp, objc, objv, flags)
+    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
+				 * 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. */
 {
     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;
+    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 ((objc < 1) || (objv == (Tcl_Obj **) NULL)) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "illegal argument vector", -1);
+        return TCL_ERROR;
+    }
+
+    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;
+            }
+        }
+    }
 
     /*
-     * If we are just starting to log an error, errorInfo is initialized from
-     * the error message in the interpreter's result.
+     * 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.
      */
 
-    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.
-	     */
+    Tcl_ResetResult(interp);
+    iPtr->cmdCount++;
+    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
 
-	    iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
-	} else {
-	    iPtr->errorInfo = iPtr->objResultPtr;
-	}
-	Tcl_IncrRefCount(iPtr->errorInfo);
-	if (!iPtr->errorCode) {
-	    Tcl_SetErrorCode(interp, "NONE", NULL);
-	}
+    /*
+     * 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);
+	iPtr->flags &= ~ERR_ALREADY_LOGGED;
     }
 
     /*
-     * Now append "message" to the end of errorInfo.
+     * Free any locally allocated storage used to call "unknown".
      */
 
-    if (length != 0) {
-	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);
+    if (localObjv != (Tcl_Obj **) NULL) {
+	Tcl_DecrRefCount(localObjv[0]);
+        ckfree((char *) localObjv);
     }
+    return result;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_VarEvalVA --
+ * Tcl_ExprString --
  *
- *	Given a variable number of string arguments, concatenate them all
- *	together and execute the result as a Tcl command.
+ *	Evaluate an expression in a string and return its value in string
+ *	form.
  *
  * Results:
- *	A standard Tcl return result. An error message or other result may be
- *	left in the interp's result.
+ *	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.
  *
  * Side effects:
- *	Depends on what was done by the command.
+ *	A Tcl object is allocated to hold a copy of the expression string.
+ *	This expression object is passed to Tcl_ExprObj and then
+ *	deallocated.
  *
  *---------------------------------------------------------------------------
  */
 
 int
-Tcl_VarEvalVA(
-    Tcl_Interp *interp,		/* Interpreter in which to evaluate command */
-    va_list argList)		/* Variable argument list. */
+Tcl_ExprString(interp, string)
+    Tcl_Interp *interp;		/* Context in which to evaluate the
+				 * expression. */
+    CONST char *string;		/* Expression to evaluate. */
 {
-    Tcl_DString buf;
-    char *string;
-    int result;
+    register Tcl_Obj *exprPtr;
+    Tcl_Obj *resultPtr;
+    int length = strlen(string);
+    char buf[TCL_DOUBLE_SPACE];
+    int result = TCL_OK;
 
-    /*
-     * 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.
-     */
+    if (length > 0) {
+	TclNewObj(exprPtr);
+	TclInitStringRep(exprPtr, string, length);
+	Tcl_IncrRefCount(exprPtr);
 
-    Tcl_DStringInit(&buf);
-    while (1) {
-	string = va_arg(argList, char *);
-	if (string == NULL) {
-	    break;
+	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_DStringAppend(&buf, string, -1);
+	Tcl_DecrRefCount(exprPtr); /* discard the expression object */
+    } else {
+	/*
+	 * An empty string. Just set the interpreter's result to 0.
+	 */
+	
+	Tcl_SetResult(interp, "0", TCL_VOLATILE);
     }
-
-    result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
-    Tcl_DStringFree(&buf);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_VarEval --
+ * Tcl_CreateObjTrace --
  *
- *	Given a variable number of string arguments, concatenate them all
- *	together and execute the result as a Tcl command.
+ *	Arrange for a procedure to be called to trace command execution.
  *
  * Results:
- *	A standard Tcl return result. An error message or other result may be
- *	left in interp->result.
+ *	The return value is a token for the trace, which may be passed
+ *	to Tcl_DeleteTrace to eliminate the trace.
  *
  * Side effects:
- *	Depends on what was done by the command.
+ *	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.  
  *
  *----------------------------------------------------------------------
  */
-	/* ARGSUSED */
-int
-Tcl_VarEval(
-    Tcl_Interp *interp,
-    ...)
-{
-    va_list argList;
-    int result;
 
-    va_start(argList, interp);
-    result = Tcl_VarEvalVA(interp, argList);
-    va_end(argList);
+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;
 
-    return result;
+    /* 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_GlobalEval --
+ * Tcl_CreateTrace --
  *
- *	Evaluate a command at global level in an interpreter.
+ *	Arrange for a procedure to be called to trace command execution.
  *
  * Results:
- *	A standard Tcl result is returned, and the interp's result is modified
- *	accordingly.
+ *	The return value is a token for the trace, which may be passed
+ *	to Tcl_DeleteTrace to eliminate the trace.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_GlobalEval(
-    Tcl_Interp *interp,		/* Interpreter in which to evaluate
+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. */
-    const char *command)	/* Command to evaluate. */
+    ClientData clientData;	/* Arbitrary value word to pass to proc. */
 {
-    register Interp *iPtr = (Interp *) interp;
-    int result;
-    CallFrame *savedVarFramePtr;
-
-    savedVarFramePtr = iPtr->varFramePtr;
-    iPtr->varFramePtr = iPtr->rootFramePtr;
-    result = Tcl_Eval(interp, command);
-    iPtr->varFramePtr = savedVarFramePtr;
-    return result;
+    StringTraceData* data;
+    data = (StringTraceData*) ckalloc( sizeof( *data ));
+    data->clientData = clientData;
+    data->proc = proc;
+    return Tcl_CreateObjTrace( interp, level, 0, StringTraceProc,
+			       (ClientData) data, StringTraceDeleteProc );
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SetRecursionLimit --
+ * StringTraceProc --
  *
- *	Set the maximum number of recursive calls that may be active for an
- *	interpreter at once.
+ *	Invoke a string-based trace procedure from an object-based
+ *	callback.
  *
  * Results:
- *	The return value is the old limit on nesting for interp.
+ *	None.
  *
  * Side effects:
- *	None.
+ *	Whatever the string-based trace procedure does.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_SetRecursionLimit(
-    Tcl_Interp *interp,		/* Interpreter whose nesting limit is to be
-				 * set. */
-    int depth)			/* New value for maximimum depth. */
+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;
 {
-    Interp *iPtr = (Interp *) interp;
-    int old;
+    StringTraceData* data = (StringTraceData*) clientData;
+    Command* cmdPtr = (Command*) commandInfo;
 
-    old = iPtr->maxNestingDepth;
-    if (depth > 0) {
-	iPtr->maxNestingDepth = depth;
+    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 **) ckalloc((unsigned) ( (objc + 1)
+						* sizeof(CONST char *) ));
+    for (i = 0; i < objc; i++) {
+	argv[i] = Tcl_GetString(objv[i]);
     }
-    return old;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's evalFlags
- *	structure. See the reference documentation for more details.
- *
- *----------------------------------------------------------------------
- */
+    argv[objc] = 0;
 
-void
-Tcl_AllowExceptions(
-    Tcl_Interp *interp)		/* Interpreter in which to set flag. */
-{
-    Interp *iPtr = (Interp *) interp;
+    /*
+     * 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 );
 
-    iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetVersion --
+ * StringTraceDeleteProc --
  *
- *	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.
+ *	Clean up memory when a string-based trace is deleted.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	None.
+ *	Allocated memory is returned to the system.
  *
  *----------------------------------------------------------------------
  */
 
-void
-Tcl_GetVersion(
-    int *majorV,
-    int *minorV,
-    int *patchLevelV,
-    int *type)
+static void
+StringTraceDeleteProc( clientData )
+    ClientData clientData;
 {
-    if (majorV != NULL) {
-	*majorV = TCL_MAJOR_VERSION;
-    }
-    if (minorV != NULL) {
-	*minorV = TCL_MINOR_VERSION;
-    }
-    if (patchLevelV != NULL) {
-	*patchLevelV = TCL_RELEASE_SERIAL;
-    }
-    if (type != NULL) {
-	*type = TCL_RELEASE_LEVEL;
-    }
+    ckfree( (char*) clientData );
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Math Functions --
+ * Tcl_DeleteTrace --
  *
- *	This page contains the functions that implement all of the built-in
- *	math functions for expressions.
+ *	Remove a trace.
  *
  * 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.
+ *	None.
  *
  * Side effects:
- *	None.
+ *	From now on there will be no more calls to the procedure given
+ *	in trace.
  *
  *----------------------------------------------------------------------
  */
 
-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_SetResult(interp, "square root of negative argument", TCL_STATIC);
-    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
-	    "domain error: argument not in valid range", NULL);
-    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.
-	 * [Bug 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) {
-	if (mp_cmp_d((const 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. */
+void
+Tcl_DeleteTrace(interp, trace)
+    Tcl_Interp *interp;		/* Interpreter that contains trace. */
+    Tcl_Trace trace;		/* Token for trace (returned previously by
+				 * Tcl_CreateTrace). */
 {
     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;
-	}
-    }
+    Trace *prevPtr, *tracePtr = (Trace *) trace;
+    register Trace **tracePtr2 = &(iPtr->tracePtr);
+    ActiveInterpTrace *activePtr;
 
     /*
-     * 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.
+     * Locate the trace entry in the interpreter's trace list,
+     * and remove it from the list.
      */
 
-#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;
+    prevPtr = NULL;
+    while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
+	prevPtr = *tracePtr2;
+	tracePtr2 = &((*tracePtr2)->nextPtr);
     }
+    if (*tracePtr2 == NULL) {
+	return;
+    }
+    (*tracePtr2) = (*tracePtr2)->nextPtr;
 
     /*
-     * 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.
+     * 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.
      */
 
-    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++;
+    for (activePtr = iPtr->activeInterpTracePtr;  activePtr != NULL;
+	    activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    if (activePtr->reverseScan) {
+		activePtr->nextTracePtr = prevPtr;
+	    } else {
+		activePtr->nextTracePtr = tracePtr->nextPtr;
 	    }
-	    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 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 (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;
+    if (!(tracePtr->flags & TCL_ALLOW_INLINE_COMPILATION)) {
+	iPtr->tracesForbiddingInline--;
+	if (iPtr->tracesForbiddingInline == 0) {
+	    iPtr->flags &= ~DONT_COMPILE_CMDS_INLINE;
+	    iPtr->compileEpoch++;
 	}
-
-	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.
+     * Execute any delete callback.
      */
 
-    iPtr->flags |= RAND_SEED_INITIALIZED;
-    iPtr->randSeed = i;
-    iPtr->randSeed &= (unsigned long) 0x7fffffff;
-    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
-	iPtr->randSeed ^= 123459876;
+    if (tracePtr->delProc != NULL) {
+	(tracePtr->delProc)(tracePtr->clientData);
     }
 
-    /*
-     * 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.
-     */
+    /* Delete the trace object */
 
-    return ExprRandFunc(clientData, interp, 1, objv);
+    Tcl_EventuallyFree((char*)tracePtr, TCL_DYNAMIC);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * MathFuncWrongNumArgs --
+ * Tcl_AddErrorInfo --
  *
- *	Generate an error message when a math function presents the wrong
- *	number of arguments.
+ *	Add information to the "errorInfo" variable that describes the
+ *	current error.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	An error message is stored in the interpreter result.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
+void
+Tcl_AddErrorInfo(interp, message)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    CONST char *message;	/* Message to record. */
 {
-    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));
-    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+    Tcl_AddObjErrorInfo(interp, message, -1);
 }
 
-#ifdef USE_DTRACE
 /*
  *----------------------------------------------------------------------
  *
- * DTraceObjCmd --
+ * Tcl_AddObjErrorInfo --
  *
- *	This function is invoked to process the "::tcl::dtrace" Tcl command.
+ *	Add information to the "errorInfo" variable that describes the
+ *	current error. This routine differs from Tcl_AddErrorInfo by
+ *	taking a byte pointer and length.
  *
  * Results:
- *	A standard Tcl object result.
+ *	None.
  *
  * Side effects:
- *	The 'tcl-probe' DTrace probe is triggered (if it is enabled).
+ *	"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.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-DTraceObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+void
+Tcl_AddObjErrorInfo(interp, message, length)
+    Tcl_Interp *interp;		/* Interpreter to which error information
+				 * pertains. */
+    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. */
 {
-    if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
-	char *a[10];
-	int i = 0;
+    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.
+     */
 
-	while (i++ < 10) {
-	    a[i-1] = i < objc ? TclGetString(objv[i]) : NULL;
+    if (!(iPtr->flags & ERR_IN_PROGRESS)) { /* just starting to log error */
+	iPtr->flags |= ERR_IN_PROGRESS;
+
+	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);
+	}
+
+	/*
+	 * 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_DTRACE_TCL_PROBE(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
-		a[8], a[9]);
     }
-    return TCL_OK;
+
+    /*
+     * Now append "message" to the end of errorInfo.
+     */
+
+    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 */
+    }
 }
 
 /*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  *
- * TclDTraceInfo --
+ * Tcl_VarEvalVA --
  *
- *	Extract information from a TIP280 dict for use by DTrace probes.
+ *	Given a variable number of string arguments, concatenate them
+ *	all together and execute the result as a Tcl command.
  *
  * Results:
- *	None.
+ *	A standard Tcl return result.  An error message or other result may
+ *	be left in the interp's result.
  *
  * Side effects:
- *	None.
+ *	Depends on what was done by the command.
  *
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  */
 
-void
-TclDTraceInfo(
-    Tcl_Obj *info,
-    const char **args,
-    int *argsi)
+int
+Tcl_VarEvalVA (interp, argList)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate command. */
+    va_list argList;		/* Variable argument list. */
 {
-    static Tcl_Obj *keys[10] = { NULL };
-    Tcl_Obj **k = keys, *val;
-    int i = 0;
-
-    if (!*k) {
-#define kini(s) TclNewLiteralStringObj(keys[i], s); i++
-	kini("cmd");	kini("type");	kini("proc");	kini("file");
-	kini("method");	kini("class");	kini("lambda");	kini("object");
-	kini("line");	kini("level");
-#undef kini
-    }
-    for (i = 0; i < 6; i++) {
-	Tcl_DictObjGet(NULL, info, *k++, &val);
-	args[i] = val ? TclGetString(val) : NULL;
-    }
-    /* no "proc" -> use "lambda" */
-    if (!args[2]) {
-	Tcl_DictObjGet(NULL, info, *k, &val);
-	args[2] = val ? TclGetString(val) : NULL;
-    }
-    k++;
-    /* no "class" -> use "object" */
-    if (!args[5]) {
-	Tcl_DictObjGet(NULL, info, *k, &val);
-	args[5] = 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_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.
+     */
+
+    Tcl_DStringInit(&buf);
+    while (1) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
+	    break;
 	}
+	Tcl_DStringAppend(&buf, string, -1);
     }
+
+    result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
+    Tcl_DStringFree(&buf);
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * DTraceCmdReturn --
+ * Tcl_VarEval --
  *
- *	NR callback for DTrace command return probes.
+ *	Given a variable number of string arguments, concatenate them
+ *	all together and execute the result as a Tcl command.
  *
  * Results:
- *	None.
+ *	A standard Tcl return result.  An error message or other
+ *	result may be left in interp->result.
  *
  * Side effects:
- *	None.
+ *	Depends on what was done by the command.
  *
  *----------------------------------------------------------------------
  */
-
-static int
-DTraceCmdReturn(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
+	/* VARARGS2 */ /* ARGSUSED */
+int
+Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 {
-    char *cmdName = TclGetString((Tcl_Obj *) data[0]);
+    Tcl_Interp *interp;
+    va_list argList;
+    int result;
 
-    if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
-	TCL_DTRACE_CMD_RETURN(cmdName, result);
-    }
-    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
-	Tcl_Obj *r = Tcl_GetObjResult(interp);
+    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+    result = Tcl_VarEvalVA(interp, argList);
+    va_end(argList);
 
-	TCL_DTRACE_CMD_RESULT(cmdName, result, TclGetString(r), r);
-    }
     return result;
 }
-
-TCL_DTRACE_DEBUG_LOG()
-
-#endif /* USE_DTRACE */
 
 /*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  *
- * Tcl_NRCallObjProc --
+ * Tcl_GlobalEval --
  *
- *	This function calls an objProc directly while managing things properly
- *	if it happens to be an NR objProc. It is meant to be used by extenders
- *	that provide an NR implementation of a command, as this function
- *	permits a trivial coding of the non-NR objProc.
+ *	Evaluate a command at global level in an interpreter.
  *
  * 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.
+ *	A standard Tcl result is returned, and the interp's result is
+ *	modified accordingly.
  *
  * Side effects:
- *	Depends on the objProc.
+ *	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.
  *
- *----------------------------------------------------------------------
+ ---------------------------------------------------------------------------
  */
 
 int
-Tcl_NRCallObjProc(
-    Tcl_Interp *interp,
-    Tcl_ObjCmdProc *objProc,
-    ClientData clientData,
-    int objc,
-    Tcl_Obj *const objv[])
+Tcl_GlobalEval(interp, command)
+    Tcl_Interp *interp;		/* Interpreter in which to evaluate command. */
+    CONST char *command;	/* Command to evaluate. */
 {
-    int result = TCL_OK;
-    NRE_callback *rootPtr = TOP_CB(interp);
-
-#ifdef USE_DTRACE
-    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
-	const char *a[10];
-	int i = 0;
-
-	while (i < 10) {
-	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
-	}
-	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() && ((Interp *) interp)->cmdFramePtr) {
-	Tcl_Obj *info = TclInfoFrame(interp, ((Interp *) interp)->cmdFramePtr);
-	const char *a[6]; int i[2];
+    register Interp *iPtr = (Interp *) interp;
+    int result;
+    CallFrame *savedVarFramePtr;
 
-	TclDTraceInfo(info, a, i);
-	TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
-	TclDecrRefCount(info);
-    }
-    if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
-	    && objc) {
-	TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
-    }
-    if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
-	TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
-		(Tcl_Obj **)(objv + 1));
-    }
-#endif /* USE_DTRACE */
-    result = objProc(clientData, interp, objc, objv);
-    return TclNRRunCallbacks(interp, result, rootPtr);
+    savedVarFramePtr = iPtr->varFramePtr;
+    iPtr->varFramePtr = NULL;
+    result = Tcl_Eval(interp, command);
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_NRCreateCommand --
+ * Tcl_SetRecursionLimit --
  *
- *	Define a new NRE-enabled object-based command in a command table.
+ *	Set the maximum number of recursive calls that may be active
+ *	for an interpreter at once.
  *
  * Results:
- *	The return value is a token for the command, which can be used in
- *	future calls to Tcl_GetCommandName.
+ *	The return value is the old limit on nesting for interp.
  *
  * 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.
- *
- *	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.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Command
-Tcl_NRCreateCommand(
-    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 function to associate with
-				 * name, provides direct access for direct
-				 * calls. */
-    Tcl_ObjCmdProc *nreProc,	/* Object-based function to associate with
-				 * name, provides NR implementation */
-    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. */
-{
-    Command *cmdPtr = (Command *)
-	    Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
-
-    cmdPtr->nreProc = nreProc;
-    return (Tcl_Command) cmdPtr;
-}
-
-/****************************************************************************
- * Stuff for the public api
- ****************************************************************************/
-
-int
-Tcl_NREvalObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    int flags)
-{
-    return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
-}
-
-int
-Tcl_NREvalObjv(
-    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, TCL_EVAL_INVOKE and
-				 * TCL_EVAL_NOERR are currently supported. */
-{
-    return TclNREvalObjv(interp, objc, objv, flags, NULL);
-}
-
-int
-Tcl_NRCmdSwap(
-    Tcl_Interp *interp,
-    Tcl_Command cmd,
-    int objc,
-    Tcl_Obj *const objv[],
-    int flags)
-{
-    return TclNREvalObjv(interp, objc, objv, flags, (Command *) cmd);
-}
-
-/*****************************************************************************
- * Stuff for tailcalls
- *****************************************************************************
- *
- * Just to show that IT CAN BE DONE! The precise semantics are not simple,
- * require more thought. Possibly need a new Tcl return code to do it right?
- * Questions include:
- *   (1) How is the objc/objv tailcall to be run? My current thinking is that
- *	 it should essentially be
- *	     [tailcall a b c] <=> [uplevel 1 [list a b c]]
- *	 with two caveats
- *	     (a) the current frame is dropped first, after running all pending
- *		 cleanup tasks and saving its namespace
- *	     (b) 'a' is looked up in the returning frame's namespace, but the
- *		 command is run in the context to which we are returning
- *	 Current implementation does this if [tailcall] is called from within
- *	 a proc, errors otherwise.
- *   (2) Should a tailcall bypass [catch] in the returning frame? Current
- *	 implementation does not (or does it? Changed, test!) - it causes an
- *	 error.
- *
- * FIXME NRE!
- */
-
-void
-TclSpliceTailcall(
-    Tcl_Interp *interp,
-    NRE_callback *tailcallPtr)
-{
-    /*
-     * Find the splicing spot: right before the NRCommand of the thing
-     * being tailcalled. Note that we skip NRCommands marked in data[1]
-     * (used by command redirectors).
-     */
-
-    NRE_callback *runPtr;
-
-    for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
-	if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
-            break;
-        }
-    }
-    if (!runPtr) {
-        Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
-    }
-
-    tailcallPtr->nextPtr = runPtr->nextPtr;
-    runPtr->nextPtr = tailcallPtr;
-}
-
-int
-TclNRTailcallObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (objc < 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    if (!iPtr->varFramePtr->isProcCallFrame) {	/* or is upleveled */
-        Tcl_SetResult(interp,
-                "tailcall can only be called from a proc or lambda",
-                TCL_STATIC);
-        Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Invocation without args just clears a scheduled tailcall; invocation
-     * with an argument replaces any previously scheduled tailcall.
-     */
-
-    if (iPtr->varFramePtr->tailcallPtr) {
-        ClearTailcall(interp, iPtr->varFramePtr->tailcallPtr);
-        iPtr->varFramePtr->tailcallPtr = NULL;
-    }
-
-    /*
-     * Create the callback to actually evaluate the tailcalled
-     * command, then set it in the varFrame so that PopCallFrame can use it
-     * at the proper time. Being lazy: exploit the TclNRAddCallBack macro to
-     * build the callback.
-     */
-
-    if (objc > 1) {
-        Tcl_Obj *listPtr, *nsObjPtr;
-        Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-        Tcl_Namespace *ns1Ptr;
-        NRE_callback *tailcallPtr;
-
-        listPtr = Tcl_NewListObj(objc-1, objv+1);
-        Tcl_IncrRefCount(listPtr);
-
-        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
-        if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
-                || (nsPtr != ns1Ptr)) {
-            Tcl_Panic("Tailcall failed to find the proper namespace");
-        }
-        Tcl_IncrRefCount(nsObjPtr);
-
-        TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr,
-                NULL, NULL);
-        tailcallPtr = TOP_CB(interp);
-        TOP_CB(interp) = tailcallPtr->nextPtr;
-        iPtr->varFramePtr->tailcallPtr = tailcallPtr;
-    }
-    return TCL_RETURN;
-}
-
 int
-NRTailcallEval(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
+Tcl_SetRecursionLimit(interp, depth)
+    Tcl_Interp *interp;			/* Interpreter whose nesting limit
+					 * is to be set. */
+    int depth;				/* New value for maximimum depth. */
 {
     Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *listPtr = data[0];
-    Tcl_Obj *nsObjPtr = data[1];
-    Tcl_Namespace *nsPtr;
-    int objc;
-    Tcl_Obj **objv;
-
-    if (result == TCL_OK) {
-	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
-    }
-
-    if (result != TCL_OK) {
-        /*
-         * Tailcall execution was preempted, eg by an intervening catch or by
-         * a now-gone namespace: cleanup and return.
-         */
-
-        TailcallCleanup(data, interp, result);
-        return result;
-    }
-
-    /*
-     * Perform the tailcall
-     */
-
-    TclNRDeferCallback(interp, TailcallCleanup, listPtr, nsObjPtr, NULL,NULL);
-    iPtr->lookupNsPtr = (Namespace *) nsPtr;
-    ListObjGetElements(listPtr, objc, objv);
-    return TclNREvalObjv(interp, objc, objv, 0, NULL);
-}
-
-static int
-TailcallCleanup(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_DecrRefCount((Tcl_Obj *) data[0]);
-    Tcl_DecrRefCount((Tcl_Obj *) data[1]);
-    return result;
-}
-
-static void
-ClearTailcall(
-    Tcl_Interp *interp,
-    NRE_callback *tailcallPtr)
-{
-    TailcallCleanup(tailcallPtr->data, interp, TCL_OK);
-    TCLNR_FREE(interp, tailcallPtr);
-}
+    int old;
 
-
-void
-Tcl_NRAddCallback(
-    Tcl_Interp *interp,
-    Tcl_NRPostProc *postProcPtr,
-    ClientData data0,
-    ClientData data1,
-    ClientData data2,
-    ClientData data3)
-{
-    if (!(postProcPtr)) {
-	Tcl_Panic("Adding a callback without an objProc?!");
+    old = iPtr->maxNestingDepth;
+    if (depth > 0) {
+	iPtr->maxNestingDepth = depth;
     }
-    TclNRAddCallback(interp, postProcPtr, data0, data1, data2, data3);
+    return old;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclNRCoroutineObjCmd -- (and friends)
+ * Tcl_AllowExceptions --
  *
- *	This object-based function is invoked to process the "coroutine" Tcl
- *	command. It is heavily based on "apply".
+ *	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:
- *	A standard Tcl object result value.
+ *	None.
  *
  * Side effects:
- *	A new procedure gets created.
+ *	The TCL_ALLOW_EXCEPTIONS flag gets set in the interpreter's
+ *	evalFlags structure.  See the reference documentation for
+ *	more details.
  *
- * ** FIRST EXPERIMENTAL IMPLEMENTATION **
- *
- * It is fairly amateurish and not up to our standards - mainly in terms of
- * error messages and [info] interaction. Just to test the infrastructure in
- * teov and tebc.
  *----------------------------------------------------------------------
  */
 
-#define iPtr ((Interp *) interp)
-
-int
-TclNRYieldObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
-	return TCL_ERROR;
-    }
-
-    if (!corPtr) {
-	Tcl_SetResult(interp, "yield can only be called in a coroutine",
-		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
-	return TCL_ERROR;
-    }
-
-    if (objc == 2) {
-	Tcl_SetObjResult(interp, objv[1]);
-    }
-
-    NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
-    TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
-            clientData, NULL, NULL);
-    return TCL_OK;
-}
-
-int
-TclNRYieldToObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-    Tcl_Obj *listPtr, *nsObjPtr;
-    Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-    Tcl_Namespace *ns1Ptr;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    if (!corPtr) {
-	Tcl_SetResult(interp, "yieldto can only be called in a coroutine",
-		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Add the tailcall in the caller env, then just yield.
-     *
-     * This is essentially code from TclNRTailcallObjCmd
-     */
-
-    listPtr = Tcl_NewListObj(objc-1, objv+1);
-    Tcl_IncrRefCount(listPtr);
-
-    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
-    if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
-	    || (nsPtr != ns1Ptr)) {
-	Tcl_Panic("yieldto failed to find the proper namespace");
-    }
-    Tcl_IncrRefCount(nsObjPtr);
-
-    /*
-     * Add the callback in the caller's env, then instruct TEBC to yield.
-     */
-
-    iPtr->execEnvPtr = corPtr->callerEEPtr;
-    TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr,
-	    NULL);
-    iPtr->execEnvPtr = corPtr->eePtr;
-
-    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
-}
-
-static int
-YieldToCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    /* CoroutineData *corPtr = data[0];*/
-    Tcl_Obj *listPtr = data[1];
-    ClientData nsPtr = data[2];
-    NRE_callback *cbPtr;
-
-    /*
-     * yieldTo: invoke the command using tailcall tech.
-     */
-
-    TclNRAddCallback(interp, NRTailcallEval, listPtr, nsPtr, NULL, NULL);
-    cbPtr = TOP_CB(interp);
-    TOP_CB(interp) = cbPtr->nextPtr;
-
-    TclSpliceTailcall(interp, cbPtr);
-    return TCL_OK;
-}
-
-static int
-RewindCoroutineCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    return Tcl_RestoreInterpState(interp, data[0]);
-}
-
-static int
-RewindCoroutine(
-    CoroutineData *corPtr,
-    int result)
+void
+Tcl_AllowExceptions(interp)
+    Tcl_Interp *interp;		/* Interpreter in which to set flag. */
 {
-    Tcl_Interp *interp = corPtr->eePtr->interp;
-    Tcl_InterpState state = Tcl_SaveInterpState(interp, result);
-
-    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
-    NRE_ASSERT(corPtr->eePtr != NULL);
-    NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr);
+    Interp *iPtr = (Interp *) interp;
 
-    corPtr->eePtr->rewind = 1;
-    TclNRAddCallback(interp, RewindCoroutineCallback, state,
-	    NULL, NULL, NULL);
-    return NRInterpCoroutine(corPtr, interp, 0, NULL);
+    iPtr->evalFlags |= TCL_ALLOW_EXCEPTIONS;
 }
-
-static void
-DeleteCoroutine(
-    ClientData clientData)
-{
-    CoroutineData *corPtr = clientData;
-    Tcl_Interp *interp = corPtr->eePtr->interp;
-    NRE_callback *rootPtr = TOP_CB(interp);
 
-    if (COR_IS_SUSPENDED(corPtr)) {
-	TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
-    }
-}
-
-static int
-NRCoroutineCallerCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CoroutineData *corPtr = data[0];
-    Command *cmdPtr = corPtr->cmdPtr;
-
-    /*
-     * This is the last callback in the caller execEnv, right before switching
-     * to the coroutine's
-     */
-
-    NRE_ASSERT(iPtr->execEnvPtr == corPtr->callerEEPtr);
-
-    if (!corPtr->eePtr) {
-	/*
-	 * The execEnv was wound down but not deleted for our sake. We finish
-	 * the job here. The caller context has already been restored.
-	 */
-
-	NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr);
-	NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
-	NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
-	ckfree(corPtr);
-	return result;
-    }
-
-    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
-    SAVE_CONTEXT(corPtr->running);
-    RESTORE_CONTEXT(corPtr->caller);
-
-    if (cmdPtr->flags & CMD_IS_DELETED) {
-	/*
-	 * The command was deleted while it was running: wind down the
-	 * execEnv, this will do the complete cleanup. RewindCoroutine will
-	 * restore both the caller's context and interp state.
-	 */
-
-	return RewindCoroutine(corPtr, result);
-    }
-
-    return result;
-}
-
-static int
-NRCoroutineExitCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CoroutineData *corPtr = data[0];
-    Command *cmdPtr = corPtr->cmdPtr;
-
-    /*
-     * This runs at the bottom of the Coroutine's execEnv: it will be executed
-     * when the coroutine returns or is wound down, but not when it yields. It
-     * deletes the coroutine and restores the caller's environment.
-     */
-
-    NRE_ASSERT(interp == corPtr->eePtr->interp);
-    NRE_ASSERT(TOP_CB(interp) == NULL);
-    NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
-    NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
-    NRE_ASSERT((corPtr->callerEEPtr->callbackPtr->procPtr == NRCoroutineCallerCallback));
-
-    cmdPtr->deleteProc = NULL;
-    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
-    TclCleanupCommandMacro(cmdPtr);
-
-    corPtr->eePtr->corPtr = NULL;
-    TclDeleteExecEnv(corPtr->eePtr);
-    corPtr->eePtr = NULL;
-
-    corPtr->stackLevel = NULL;
-
-    /*
-     * #280.
-     * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
-     * command arguments in bytecode.
-     */
-
-    Tcl_DeleteHashTable(corPtr->lineLABCPtr);
-    ckfree(corPtr->lineLABCPtr);
-    corPtr->lineLABCPtr = NULL;
-
-    RESTORE_CONTEXT(corPtr->caller);
-    iPtr->execEnvPtr = corPtr->callerEEPtr;
-    iPtr->numLevels++;
-
-    return result;
-}
 
 /*
  *----------------------------------------------------------------------
  *
- * NRCoroutineActivateCallback --
- *
- *      This is the workhorse for coroutines: it implements both yield and
- *      resume.
+ * Tcl_GetVersion
  *
- *      It is important that both be implemented in the same callback: the
- *      detection of the impossibility to suspend due to a busy C-stack relies
- *      on the precise position of a local variable in the stack. We do not
- *      want the compiler to play tricks on us, either by moving things around
- *      or inlining.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-NRCoroutineActivateCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CoroutineData *corPtr = data[0];
-    int type = PTR2INT(data[1]);
-    int numLevels, unused;
-    int *stackLevel = &unused;
-
-    if (!corPtr->stackLevel) {
-        /*
-         * -- Coroutine is suspended --
-         * Push the callback to restore the caller's context on yield or
-         * return.
-         */
-
-        TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr,
-                NULL, NULL, NULL);
-
-        /*
-         * Record the stackLevel at which the resume is happening, then swap
-         * the interp's environment to make it suitable to run this coroutine.
-         */
-
-        corPtr->stackLevel = stackLevel;
-        numLevels = corPtr->auxNumLevels;
-        corPtr->auxNumLevels = iPtr->numLevels;
-
-        SAVE_CONTEXT(corPtr->caller);
-        corPtr->callerEEPtr = iPtr->execEnvPtr;
-        RESTORE_CONTEXT(corPtr->running);
-        iPtr->execEnvPtr = corPtr->eePtr;
-        iPtr->numLevels += numLevels;
-    } else {
-        /*
-         * Coroutine is active: yield
-         */
-
-        if (corPtr->stackLevel != stackLevel) {
-            Tcl_SetResult(interp, "cannot yield: C stack busy",
-                    TCL_STATIC);
-            Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
-                    NULL);
-            return TCL_ERROR;
-        }
-
-        if (type == CORO_ACTIVATE_YIELD) {
-            corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
-        } else if (type == CORO_ACTIVATE_YIELDM) {
-            corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
-        } else {
-            Tcl_Panic("Yield received an option which is not implemented");
-        }
-
-        corPtr->stackLevel = NULL;
-
-        numLevels = iPtr->numLevels;
-        iPtr->numLevels = corPtr->auxNumLevels;
-        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
-
-        iPtr->execEnvPtr = corPtr->callerEEPtr;
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
+ *	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.
  *
- * NRCoroInjectObjCmd --
+ * Results:
+ *	None.
  *
- *      Implementation of [::tcl::unsupported::inject] command.
+ * Side effects:
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-NRCoroInjectObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+void
+Tcl_GetVersion(majorV, minorV, patchLevelV, type)
+    int *majorV;
+    int *minorV;
+    int *patchLevelV;
+    int *type;
 {
-    Command *cmdPtr;
-    CoroutineData *corPtr;
-    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
-
-    /*
-     * Usage more or less like tailcall:
-     *   inject coroName cmd ?arg1 arg2 ...?
-     */
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
-	return TCL_ERROR;
-    }
-
-    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
-    if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) {
-        Tcl_AppendResult(interp, "can only inject a command into a coroutine",
-                NULL);
-        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
-                TclGetString(objv[1]), NULL);
-        return TCL_ERROR;
+    if (majorV != NULL) {
+        *majorV = TCL_MAJOR_VERSION;
     }
-
-    corPtr = cmdPtr->objClientData;
-    if (!COR_IS_SUSPENDED(corPtr)) {
-        Tcl_AppendResult(interp,
-                "can only inject a command into a suspended coroutine", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
-        return TCL_ERROR;
+    if (minorV != NULL) {
+        *minorV = TCL_MINOR_VERSION;
     }
-
-    /*
-     * Add the callback to the coro's execEnv, so that it is the first thing
-     * to happen when the coro is resumed.
-     */
-
-    iPtr->execEnvPtr = corPtr->eePtr;
-    TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
-    iPtr->execEnvPtr = savedEEPtr;
-
-    return TCL_OK;
-}
-
-int
-NRInterpCoroutine(
-    ClientData clientData,
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    CoroutineData *corPtr = clientData;
-
-    if (!COR_IS_SUSPENDED(corPtr)) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "coroutine \"", Tcl_GetString(objv[0]),
-		"\" is already running", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
-	return TCL_ERROR;
+    if (patchLevelV != NULL) {
+        *patchLevelV = TCL_RELEASE_SERIAL;
     }
-
-    /*
-     * Parse all the arguments to work out what to feed as the result of the
-     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine
-     * is deleted!
-     */
-
-    switch (corPtr->nargs) {
-    case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
-        if (objc == 2) {
-            Tcl_SetObjResult(interp, objv[1]);
-        } else if (objc > 2) {
-            Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
-            return TCL_ERROR;
-        }
-        break;
-    default:
-        if (corPtr->nargs != objc-1) {
-            Tcl_SetObjResult(interp,
-                    Tcl_NewStringObj("wrong coro nargs; how did we get here? "
-                    "not implemented!", -1));
-            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-            return TCL_ERROR;
-        }
-        /* fallthrough */
-    case COROUTINE_ARGUMENTS_ARBITRARY:
-        if (objc > 1) {
-            Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1));
-        }
-        break;
+    if (type != NULL) {
+        *type = TCL_RELEASE_LEVEL;
     }
-
-    TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
-            NULL, NULL, NULL);
-    return TCL_OK;
 }
+#ifdef USE_DTRACE
 
 /*
  *----------------------------------------------------------------------
  *
- * TclNRCoroutineObjCmd --
+ * DTraceObjCmd --
+ *
+ *	This function is invoked to process the "::tcl::dtrace" Tcl command.
+ *
+ * Results:
+ *	A standard Tcl object result.
  *
- *      Implementation of [coroutine] command; see documentation for
- *      description of what this does.
+ * Side effects:
+ *	The 'tcl-probe' DTrace probe is triggered (if it is enabled).
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclNRCoroutineObjCmd(
+static int
+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. */
 {
-    Command *cmdPtr;
-    CoroutineData *corPtr;
-    const char *fullName, *procName;
-    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
-    Tcl_DString ds;
-    Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
-     * something in tclUtil.c to find the FQ name.
-     */
-
-    fullName = TclGetString(objv[1]);
-    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
-	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
-
-    if (nsPtr == NULL) {
-	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
-		"\": unknown namespace", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
-	return TCL_ERROR;
-    }
-    if (procName == NULL) {
-	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
-		"\": bad procedure name", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
-	return TCL_ERROR;
-    }
-    if ((nsPtr != iPtr->globalNsPtr)
-	    && (procName != NULL) && (procName[0] == ':')) {
-	Tcl_AppendResult(interp, "can't create procedure \"", procName,
-		"\" in non-global namespace with name starting with \":\"",
-		NULL);
-        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * We ARE creating the coroutine command: allocate the corresponding
-     * struct and create the corresponding command.
-     */
-
-    corPtr = ckalloc(sizeof(CoroutineData));
-
-    Tcl_DStringInit(&ds);
-    if (nsPtr != iPtr->globalNsPtr) {
-	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
-	Tcl_DStringAppend(&ds, "::", 2);
-    }
-    Tcl_DStringAppend(&ds, procName, -1);
-
-    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
-	    /*objProc*/ NULL, NRInterpCoroutine, corPtr, DeleteCoroutine);
-    Tcl_DStringFree(&ds);
-
-    corPtr->cmdPtr = cmdPtr;
-    cmdPtr->refCount++;
-
-    /*
-     * #280.
-     * Provide the new coroutine with its own copy of the lineLABCPtr
-     * hashtable for literal command arguments in bytecode. Note that that
-     * CFWordBC chains are not duplicated, only the entrypoints to them. This
-     * means that in the presence of coroutines each chain is potentially a
-     * tree. Like the chain -> tree conversion of the CmdFrame stack.
-     */
-
-    {
-	Tcl_HashSearch hSearch;
-	Tcl_HashEntry *hePtr;
-
-	corPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
-
-	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
-		hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
-	    int isNew;
-	    Tcl_HashEntry *newPtr =
-		    Tcl_CreateHashEntry(corPtr->lineLABCPtr,
-		    Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr),
-		    &isNew);
+    if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
+	char *a[10];
+	int i = 0;
 
-	    Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
+	while (i++ < 10) {
+	    a[i-1] = i < objc ? TclGetString(objv[i]) : NULL;
 	}
+	TCL_DTRACE_TCL_PROBE(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
+		a[8], a[9]);
     }
-
-    /*
-     * Create the base context.
-     */
-
-    corPtr->running.framePtr = iPtr->rootFramePtr;
-    corPtr->running.varFramePtr = iPtr->rootFramePtr;
-    corPtr->running.cmdFramePtr = NULL;
-    corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
-    corPtr->stackLevel = NULL;
-    corPtr->auxNumLevels = 0;
-    iPtr->numLevels--;
-
-    /*
-     * Create the coro's execEnv, switch to it to push the exit and coro
-     * command callbacks, then switch back.
-     */
-
-    corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
-    corPtr->callerEEPtr = iPtr->execEnvPtr;
-    corPtr->eePtr->corPtr = corPtr;
-
-    SAVE_CONTEXT(corPtr->caller);
-    corPtr->callerEEPtr = iPtr->execEnvPtr;
-    RESTORE_CONTEXT(corPtr->running);
-    iPtr->execEnvPtr = corPtr->eePtr;
-
-    TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
-	    NULL, NULL, NULL);
-
-    iPtr->lookupNsPtr = lookupNsPtr;
-    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
-
-    SAVE_CONTEXT(corPtr->running);
-    RESTORE_CONTEXT(corPtr->caller);
-    iPtr->execEnvPtr = corPtr->callerEEPtr;
-
-    /*
-     * Now just resume the coroutine. Take care to insure that the command is
-     * looked up in the correct namespace.
-     */
-
-    TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
-            NULL, NULL, NULL);
     return TCL_OK;
 }
-
-/*
- * This is used in the [info] ensemble
- */
 
-int
-TclInfoCoroutineCmd(
-    ClientData dummy,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-
-    if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {
-	Tcl_Obj *namePtr;
-
-	TclNewObj(namePtr);
-	Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, namePtr);
-	Tcl_SetObjResult(interp, namePtr);
-    }
-    return TCL_OK;
-}
+TCL_DTRACE_DEBUG_LOG()
 
-#undef iPtr
+#endif /* USE_DTRACE */
 
 /*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
  * End:
  */
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 444e7fa..8eb3ac3 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,13 +7,12 @@
  * 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 "tommath.h"
-
+#include "tclPort.h"
 #include <math.h>
 
 /*
@@ -25,27 +24,21 @@
 #define BINARY_NOCOUNT -2	/* No count was specified in format. */
 
 /*
- * 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
+ * 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
@@ -54,105 +47,49 @@
  * Prototypes for local procedures defined in this file:
  */
 
-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(const 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 length, int type);
-/* Binary ensemble commands */
-static int		BinaryFormatCmd(ClientData clientData,
-			    Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		BinaryScanCmd(ClientData clientData,
-			    Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-/* Binary encoding sub-ensemble commands */
-static int		BinaryEncodeHex(ClientData clientData,
-			    Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		BinaryDecodeHex(ClientData clientData,
-			    Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		BinaryEncode64(ClientData clientData,
-			    Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		BinaryDecodeUu(ClientData clientData,
-			    Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		BinaryDecode64(ClientData clientData,
-			    Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-
-/*
- * The following tables are used by the binary encoders
- */
-
-static const char HexDigits[16] = {
-    '0', '1', '2', '3', '4', '5', '6', '7',
-    '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'
-};
-
-static const char UueDigits[65] = {
-    '`', '!', '"', '#', '$', '%', '&', '\'',
-    '(', ')', '*', '+', ',', '-', '.', '/',
-    '0', '1', '2', '3', '4', '5', '6', '7',
-    '8', '9', ':', ';', '<', '=', '>', '?',
-    '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
-    'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
-    'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
-    'X', 'Y', 'Z', '[', '\\',']', '^', '_',
-    '`'
-};
-
-static const char B64Digits[65] = {
-    'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
-    'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
-    'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
-    'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
-    'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
-    'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
-    'w', 'x', 'y', 'z', '0', '1', '2', '3',
-    '4', '5', '6', '7', '8', '9', '+', '/',
-    '='
-};
+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));
 
 /*
- * 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.
  */
 
-const Tcl_ObjType tclByteArrayType = {
+Tcl_ObjType tclByteArrayType = {
     "bytearray",
     FreeByteArrayInternalRep,
     DupByteArrayInternalRep,
@@ -161,10 +98,10 @@ const 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 {
@@ -172,58 +109,71 @@ typedef struct ByteArray {
 				 * array. */
     int allocated;		/* The amount of space actually allocated
 				 * minus 1 byte. */
-    unsigned char bytes[1];	/* 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) \
-		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
+#define BYTEARRAY_SIZE(len)	\
+		((unsigned) (sizeof(ByteArray) - 4 + (len)))
 #define GET_BYTEARRAY(objPtr) \
 		((ByteArray *) (objPtr)->internalRep.otherValuePtr)
 #define SET_BYTEARRAY(objPtr, baPtr) \
-		(objPtr)->internalRep.otherValuePtr = (void *) (baPtr)
+		(objPtr)->internalRep.otherValuePtr = (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(
-    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(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. */
 {
-#ifdef TCL_MEM_DEBUG
     return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
+}
+
 #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_Obj *objPtr;
 
     TclNewObj(objPtr);
     Tcl_SetByteArrayObj(objPtr, bytes, length);
     return objPtr;
-#endif /* TCL_MEM_DEBUG */
 }
+#endif /* TCL_MEM_DEBUG */
 
 /*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  *
  * Tcl_DbNewByteArrayObj --
  *
@@ -238,37 +188,53 @@ Tcl_NewByteArrayObj(
  *	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(
-    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(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
 				 * 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. */
 {
-#ifdef TCL_MEM_DEBUG
     Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
     Tcl_SetByteArrayObj(objPtr, bytes, length);
     return objPtr;
+}
+
 #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
+				 * procedure; used for debugging. */
+    int line;			/* Line number in the source file; used
+				 * for debugging. */
+{
     return Tcl_NewByteArrayObj(bytes, length);
-#endif /* TCL_MEM_DEBUG */
 }
-
+#endif /* TCL_MEM_DEBUG */
+
 /*
  *---------------------------------------------------------------------------
  *
@@ -281,39 +247,36 @@ Tcl_DbNewByteArrayObj(
  *	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(
-    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
-    const unsigned char *bytes,	/* The array of bytes to use as the new
-				   value. May be NULL even if length > 0. */
-    int length)			/* Length of the array of bytes, which must
-				   be >= 0. */
+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
+				 * value. */
+    int length;			/* Length of the array of bytes, which must
+				 * be >= 0. */
 {
+    Tcl_ObjType *typePtr;
     ByteArray *byteArrayPtr;
 
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
+	panic("Tcl_SetByteArrayObj called with shared object");
+    }
+    typePtr = objPtr->typePtr;
+    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	(*typePtr->freeIntRepProc)(objPtr);
     }
-    TclFreeIntRep(objPtr);
     Tcl_InvalidateStringRep(objPtr);
 
-    length = (length < 0) ? 0 : length;
-    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+    byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
     byteArrayPtr->used = length;
     byteArrayPtr->allocated = length;
-    if (length) {
-	if (bytes) {
-	    memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
-	} else {
-	    memset(byteArrayPtr->bytes, 0, (size_t) length);
-	}
-    }
+    memcpy((VOID *) byteArrayPtr->bytes, (VOID *) bytes, (size_t) length);
 
     objPtr->typePtr = &tclByteArrayType;
     SET_BYTEARRAY(objPtr, byteArrayPtr);
@@ -324,30 +287,28 @@ Tcl_SetByteArrayObj(
  *
  * 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(
-    Tcl_Obj *objPtr,		/* The ByteArray object. */
-    int *lengthPtr)		/* If non-NULL, filled with length of the
+Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
+    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;
-
-    if (objPtr->typePtr != &tclByteArrayType) {
-	SetByteArrayFromAny(NULL, objPtr);
-    }
+    
+    SetByteArrayFromAny(NULL, objPtr);
     baPtr = GET_BYTEARRAY(objPtr);
 
     if (lengthPtr != NULL) {
@@ -361,32 +322,32 @@ Tcl_GetByteArrayFromObj(
  *
  * 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(
-    Tcl_Obj *objPtr,		/* The ByteArray object. */
-    int length)			/* New length for internal byte array. */
+Tcl_SetByteArrayLength(objPtr, length)
+    Tcl_Obj *objPtr;		/* The ByteArray object. */
+    int length;			/* New length for internal byte array. */
 {
-    ByteArray *byteArrayPtr;
-
+    ByteArray *byteArrayPtr, *newByteArrayPtr;
+    
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
+	panic("Tcl_SetObjLength called with shared object");
     }
     if (objPtr->typePtr != &tclByteArrayType) {
 	SetByteArrayFromAny(NULL, objPtr);
@@ -394,8 +355,13 @@ Tcl_SetByteArrayLength(
 
     byteArrayPtr = GET_BYTEARRAY(objPtr);
     if (length > byteArrayPtr->allocated) {
-	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
-	byteArrayPtr->allocated = length;
+	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;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
     }
     Tcl_InvalidateStringRep(objPtr);
@@ -404,7 +370,7 @@ Tcl_SetByteArrayLength(
 }
 
 /*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  *
  * SetByteArrayFromAny --
  *
@@ -416,34 +382,38 @@ Tcl_SetByteArrayLength(
  * Side effects:
  *	A ByteArray object is stored as the internal rep of objPtr.
  *
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  */
 
 static int
-SetByteArrayFromAny(
-    Tcl_Interp *interp,		/* Not used. */
-    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
+SetByteArrayFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Not used. */
+    Tcl_Obj *objPtr;		/* The object to convert to type ByteArray. */
 {
+    Tcl_ObjType *typePtr;
     int length;
-    const char *src, *srcEnd;
+    char *src, *srcEnd;
     unsigned char *dst;
     ByteArray *byteArrayPtr;
     Tcl_UniChar ch;
-
-    if (objPtr->typePtr != &tclByteArrayType) {
-	src = TclGetStringFromObj(objPtr, &length);
+    
+    typePtr = objPtr->typePtr;
+    if (typePtr != &tclByteArrayType) {
+	src = Tcl_GetStringFromObj(objPtr, &length);
 	srcEnd = src + length;
 
-	byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+	byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
 	for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
 	    src += Tcl_UtfToUniChar(src, &ch);
-	    *dst++ = UCHAR(ch);
+	    *dst++ = (unsigned char) ch;
 	}
 
 	byteArrayPtr->used = dst - byteArrayPtr->bytes;
 	byteArrayPtr->allocated = length;
 
-	TclFreeIntRep(objPtr);
+	if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
+	    (*typePtr->freeIntRepProc)(objPtr);
+	}
 	objPtr->typePtr = &tclByteArrayType;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
     }
@@ -462,26 +432,26 @@ SetByteArrayFromAny(
  *	None.
  *
  * Side effects:
- *	Frees memory.
+ *	Frees memory. 
  *
  *----------------------------------------------------------------------
  */
 
 static void
-FreeByteArrayInternalRep(
-    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
+FreeByteArrayInternalRep(objPtr)
+    Tcl_Obj *objPtr;		/* Object with internal rep to free. */
 {
-    ckfree(GET_BYTEARRAY(objPtr));
-    objPtr->typePtr = NULL;
+    ckfree((char *) GET_BYTEARRAY(objPtr));
 }
 
 /*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  *
  * 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.
@@ -489,54 +459,55 @@ FreeByteArrayInternalRep(
  * Side effects:
  *	Allocates memory.
  *
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  */
 
 static void
-DupByteArrayInternalRep(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+DupByteArrayInternalRep(srcPtr, copyPtr)
+    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;
 
-    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+    copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
     copyArrayPtr->used = length;
     copyArrayPtr->allocated = length;
-    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
+    memcpy((VOID *) copyArrayPtr->bytes, (VOID *) 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(
-    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
+UpdateStringOfByteArray(objPtr)
+    Tcl_Obj *objPtr;		/* ByteArray object whose string rep to
 				 * update. */
 {
     int i, length, size;
@@ -551,23 +522,20 @@ UpdateStringOfByteArray(
     /*
      * How much space will string rep need?
      */
-
+     
     size = length;
-    for (i = 0; i < length && size >= 0; i++) {
+    for (i = 0; i < length; 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 = ckalloc(size + 1);
+    dst = (char *) ckalloc((unsigned) (size + 1));
     objPtr->bytes = dst;
     objPtr->length = size;
 
     if (size == length) {
-	memcpy(dst, src, (size_t) size);
+	memcpy((VOID *) dst, (VOID *) src, (size_t) size);
 	dst[size] = '\0';
     } else {
 	for (i = 0; i < length; i++) {
@@ -580,154 +548,9 @@ UpdateStringOfByteArray(
 /*
  *----------------------------------------------------------------------
  *
- * TclAppendBytesToByteArray --
- *
- *	This function appends an array of bytes to a byte array object. Note
- *	that the object *must* be unshared, and the array of bytes *must not*
- *	refer to the object being appended to.  Also the caller must have
- *	already checked that the final length of the bytearray after the
- *	append operations is complete will not overflow the int range.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocates enough memory for an array of bytes of the requested total
- *	size, or possibly larger. [Bug 2992970]
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclAppendBytesToByteArray(
-    Tcl_Obj *objPtr,
-    const unsigned char *bytes,
-    int len)
-{
-    ByteArray *byteArrayPtr;
-
-    if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
-    }
-    if (len < 0) {
-	Tcl_Panic("%s must be called with definite number of bytes to append",
-		"TclAppendBytesToByteArray");
-    }
-    if (objPtr->typePtr != &tclByteArrayType) {
-	SetByteArrayFromAny(NULL, objPtr);
-    }
-    byteArrayPtr = GET_BYTEARRAY(objPtr);
-
-    /*
-     * If we need to, resize the allocated space in the byte array.
-     */
-
-    if (byteArrayPtr->used + len > byteArrayPtr->allocated) {
-	unsigned int attempt, used = byteArrayPtr->used;
-	ByteArray *tmpByteArrayPtr = NULL;
-
-	attempt = byteArrayPtr->allocated;
-	if (attempt < 1) {
-	    /*
-	     * No allocated bytes, so must be none used too. We use this
-	     * method to calculate how many bytes to allocate because we can
-	     * end up with a zero-length buffer otherwise, when doubling can
-	     * cause trouble. [Bug 3067036]
-	     */
-
-	    attempt = len + 1;
-	} else {
-	    do {
-		attempt *= 2;
-	    } while (attempt < used+len);
-	}
-
-	if (BYTEARRAY_SIZE(attempt) > BYTEARRAY_SIZE(used)) {
-	    tmpByteArrayPtr = attemptckrealloc(byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
-	}
-
-	if (tmpByteArrayPtr == NULL) {
-	    attempt = used + len;
-	    if (BYTEARRAY_SIZE(attempt) < BYTEARRAY_SIZE(used)) {
-		Tcl_Panic("attempt to allocate a bigger buffer than we can handle");
-	    }
-	    tmpByteArrayPtr = ckrealloc(byteArrayPtr,
-		    BYTEARRAY_SIZE(attempt));
-	}
-
-	byteArrayPtr = tmpByteArrayPtr;
-	byteArrayPtr->allocated = attempt;
-	byteArrayPtr->used = used;
-	SET_BYTEARRAY(objPtr, byteArrayPtr);
-    }
-
-    /*
-     * Do the append if there's any point.
-     */
-
-    if (len > 0) {
-	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
-	byteArrayPtr->used += len;
-	Tcl_InvalidateStringRep(objPtr);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitBinaryCmd --
+ * Tcl_BinaryObjCmd --
  *
- *	This function is called to create the "binary" Tcl command. See the
- *	user documentation for details on what it does.
- *
- * Results:
- *	A command token for the new command.
- *
- * Side effects:
- *	Creates a new binary command as a mapped ensemble.
- *
- *----------------------------------------------------------------------
- */
-
-static const EnsembleImplMap binaryMap[] = {
-{ "format", BinaryFormatCmd, NULL, NULL, NULL, 0 },
-{ "scan",   BinaryScanCmd, NULL, NULL, NULL, 0 },
-{ "encode", NULL, NULL, NULL, NULL, 0 },
-{ "decode", NULL, NULL, NULL, NULL, 0 },
-{ NULL, NULL, NULL, NULL, NULL, 0 }
-};
-static const EnsembleImplMap encodeMap[] = {
-{ "hex",      BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits, 0 },
-{ "uuencode", BinaryEncode64,  NULL, NULL, (ClientData)UueDigits, 0 },
-{ "base64",   BinaryEncode64,  NULL, NULL, (ClientData)B64Digits, 0 },
-{ NULL, NULL, NULL, NULL, NULL, 0 }
-};
-static const EnsembleImplMap decodeMap[] = {
-{ "hex",      BinaryDecodeHex, NULL, NULL, NULL, 0 },
-{ "uuencode", BinaryDecodeUu,  NULL, NULL, NULL, 0 },
-{ "base64",   BinaryDecode64,  NULL, NULL, NULL, 0 },
-{ NULL, NULL, NULL, NULL, NULL, 0 }
-};
-
-Tcl_Command
-TclInitBinaryCmd(
-    Tcl_Interp *interp)
-{
-    Tcl_Command binaryEnsemble;
-
-    binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap);
-    TclMakeEnsemble(interp, "binary encode", encodeMap);
-    TclMakeEnsemble(interp, "binary decode", decodeMap);
-    return binaryEnsemble;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BinaryFormatCmd --
- *
- *	This procedure implements the "binary format" Tcl command.
+ *	This procedure implements the "binary" Tcl command.
  *
  * Results:
  *	A standard Tcl result.
@@ -738,12 +561,12 @@ TclInitBinaryCmd(
  *----------------------------------------------------------------------
  */
 
-static int
-BinaryFormatCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int arg;			/* Index of next argument to consume. */
     int value = 0;		/* Current integer value to be packed.
@@ -751,835 +574,787 @@ BinaryFormatCmd(
     char cmd;			/* Current format character. */
     int count;			/* Count associated with current format
 				 * character. */
-    int flags;			/* Format field flags */
-    const char *format;	/* Pointer to current position in format
+    char *format;		/* Pointer to current position in format
 				 * string. */
-    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
+    Tcl_Obj *resultPtr;		/* 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.*/
-    const char *errorString;
-    const char *errorValue, *str;
-    int offset, size, length;
+    char *errorString, *errorValue, *str;
+    int offset, size, length, index;
+    static CONST char *options[] = { 
+	"format",	"scan",		NULL 
+    };
+    enum options { 
+	BINARY_FORMAT,	BINARY_SCAN
+    };
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
+    	Tcl_WrongNumArgs(interp, 1, objv, "option ?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.
-     */
-
-    format = TclGetString(objv[1]);
-    arg = 2;
-    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 (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
+	    &index) != TCL_OK) {
+    	return TCL_ERROR;
+    }
 
-	    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 ((enum options) index) {
+	case BINARY_FORMAT: {
+	    if (objc < 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
+		return TCL_ERROR;
 	    }
 
 	    /*
-	     * 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.
+	     * 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.
 	     */
 
-	    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;
-		}
-		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;
+	    format = Tcl_GetString(objv[2]);
+	    arg = 3;
+	    offset = 0;
+	    length = 0;
+	    while (*format != '\0') {
+		str = format;
+		if (!GetFormatSpec(&format, &cmd, &count)) {
+		    break;
 		}
-	    }
-	    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;
-    }
-
-    /*
-     * Prepare the result object by preallocating the caclulated number of
-     * bytes and filling with nulls.
-     */
-
-    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.
-     */
-
-    arg = 2;
-    format = TclGetString(objv[1]);
-    cursor = buffer;
-    maxPos = cursor;
-    while (*format != 0) {
-	flags = 0;
-	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
-	    break;
-	}
-	if ((count == 0) && (cmd != '@')) {
-	    if (cmd != 'x') {
-		arg++;
-	    }
-	    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));
-	    }
-	    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;
+		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;
 		    }
-		    if (((offset + 1) % 8) == 0) {
-			*cursor++ = UCHAR(value);
-			value = 0;
+		    case 'c': {
+			size = 1;
+			goto doNumbers;
 		    }
-		}
-	    } 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;
+		    case 's':
+		    case 'S': {
+			size = 2;
+			goto doNumbers;
 		    }
-		    if (!((offset + 1) % 8)) {
-			*cursor++ = UCHAR(value);
-			value = 0;
+		    case 'i':
+		    case 'I': {
+			size = 4;
+			goto doNumbers;
 		    }
-		}
-	    }
-	    if ((offset % 8) != 0) {
-		if (cmd == 'B') {
-		    value <<= 8 - (offset % 8);
-		} else {
-		    value >>= 8 - (offset % 8);
-		}
-		*cursor++ = UCHAR(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;
+		    case 'w':
+		    case 'W': {
+			size = 8;
+			goto doNumbers;
 		    }
-		    c = str[offset] - '0';
-		    if (c > 9) {
-			c += ('0' - 'A') + 10;
+		    case 'f': {
+			size = sizeof(float);
+			goto doNumbers;
 		    }
-		    if (c > 16) {
-			c += ('A' - 'a');
-		    }
-		    value |= (c & 0xf);
-		    if (offset % 2) {
-			*cursor++ = (char) value;
-			value = 0;
+		    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.
+			 */
+
+			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;
 		    }
-		}
-	    } else {
-		for (offset = 0; offset < count; offset++) {
-		    value >>= 4;
-
-		    if (!isxdigit(UCHAR(str[offset]))) {     /* INTL: digit */
-			errorValue = str;
-			Tcl_DecrRefCount(resultPtr);
-			goto badValue;
+		    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;
 		    }
-		    c = str[offset] - '0';
-		    if (c > 9) {
-			c += ('0' - 'A') + 10;
+		    case 'X': {
+			if (count == BINARY_NOCOUNT) {
+			    count = 1;
+			}
+			if ((count > offset) || (count == BINARY_ALL)) {
+			    count = offset;
+			}
+			if (offset > length) {
+			    length = offset;
+			}
+			offset -= count;
+			break;
 		    }
-		    if (c > 16) {
-			c += ('A' - 'a');
+		    case '@': {
+			if (offset > length) {
+			    length = offset;
+			}
+			if (count == BINARY_ALL) {
+			    offset = length;
+			} else if (count == BINARY_NOCOUNT) {
+			    goto badCount;
+			} else {
+			    offset = count;
+			}
+			break;
 		    }
-		    value |= ((c << 4) & 0xf0);
-		    if (offset % 2) {
-			*cursor++ = UCHAR(value & 0xff);
-			value = 0;
+		    default: {
+			errorString = str;
+			goto badField;
 		    }
 		}
 	    }
-	    if (offset % 2) {
-		if (cmd == 'H') {
-		    value <<= 4;
-		} else {
-		    value >>= 4;
-		}
-		*cursor++ = UCHAR(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;
-	}
-    }
-    Tcl_SetObjResult(interp, resultPtr);
-    return TCL_OK;
-
- badValue:
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "expected ", errorString,
-	" string but got \"", errorValue, "\" instead", NULL);
-    return TCL_ERROR;
-
- badCount:
-    errorString = "missing count for \"@\" field specifier";
-    goto error;
-
- badIndex:
-    errorString = "not enough arguments for all format specifiers";
-    goto error;
-
- badField:
-    {
-	Tcl_UniChar ch;
-	char buf[TCL_UTF_MAX + 1];
-
-	Tcl_UtfToUniChar(errorString, &ch);
-	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
-	Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
-	return TCL_ERROR;
-    }
-
- error:
-    Tcl_AppendResult(interp, errorString, NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BinaryScanCmd --
- *
- *	This procedure implements the "binary scan" Tcl command.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-BinaryScanCmd(
-    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.
-				 * Initialized to avoid compiler warning. */
-    char cmd;			/* Current format character. */
-    int count;			/* Count associated with current format
-				 * character. */
-    int flags;			/* Format field flags */
-    const char *format;	/* Pointer to current position in format
-				 * string. */
-    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
-    unsigned char *buffer;	/* Start of result buffer. */
-    const char *errorString;
-    const char *str;
-    int offset, size, length;
-
-    int i;
-    Tcl_Obj *valuePtr, *elementPtr;
-    Tcl_HashTable numberCacheHash;
-    Tcl_HashTable *numberCachePtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"value formatString ?varName ...?");
-	return TCL_ERROR;
-    }
-    numberCachePtr = &numberCacheHash;
-    Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
-    buffer = Tcl_GetByteArrayFromObj(objv[1], &length);
-    format = TclGetString(objv[2]);
-    arg = 3;
-    offset = 0;
-    while (*format != '\0') {
-	str = format;
-	flags = 0;
-	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
-	    goto done;
-	}
-	switch (cmd) {
-	case 'a':
-	case 'A': {
-	    unsigned char *src;
-
-	    if (arg >= objc) {
-		DeleteScanNumberCache(numberCachePtr);
-		goto badIndex;
+	    if (offset > length) {
+		length = offset;
 	    }
-	    if (count == BINARY_ALL) {
-		count = length - offset;
-	    } else {
-		if (count == BINARY_NOCOUNT) {
-		    count = 1;
-		}
-		if (count > (length - offset)) {
-		    goto done;
-		}
+	    if (length == 0) {
+		return TCL_OK;
 	    }
 
-	    src = buffer + offset;
-	    size = count;
-
 	    /*
-	     * Trim trailing nulls and spaces, if necessary.
+	     * Prepare the result object by preallocating the caclulated
+	     * number of bytes and filling with nulls.
 	     */
 
-	    if (cmd == 'A') {
-		while (size > 0) {
-		    if (src[size-1] != '\0' && src[size-1] != ' ') {
-			break;
-		    }
-		    size--;
-		}
+	    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);
 
 	    /*
-	     * 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.
+	     * 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.
 	     */
 
-#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;
-		}
-		if (count > (length - offset) * 8) {
-		    goto done;
+	    arg = 3;
+	    format = Tcl_GetString(objv[2]);
+	    cursor = buffer;
+	    maxPos = cursor;
+	    while (*format != 0) {
+		if (!GetFormatSpec(&format, &cmd, &count)) {
+		    break;
 		}
-	    }
-	    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 {
-			value = *src++;
+		if ((count == 0) && (cmd != '@')) {
+		    if (cmd != 'x') {
+			arg++;
 		    }
-		    *dest++ = (char) ((value & 1) ? '1' : '0');
+		    continue;
 		}
-	    } else {
-		for (i = 0; i < count; i++) {
-		    if (i % 8) {
-			value <<= 1;
-		    } else {
-			value = *src++;
+		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((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));
+			}
+			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;
+				}
+			    }
+			}
+			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 = Tcl_GetStringFromObj(objv[arg++], &length);
+			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;
+				    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 (offset % 2) {
+			    if (cmd == 'H') {
+				value <<= 4;
+			    } else {
+				value >>= 4;
+			    }
+			    *cursor++ = (unsigned char) value;
+			}
+
+			while (cursor < last) {
+			    *cursor++ = '\0';
+			}
+			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;
+			    }
+			}
+			arg++;
+			for (i = 0; i < count; i++) {
+			    if (FormatNumber(interp, cmd, listv[i], &cursor)
+				    != TCL_OK) {
+				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;
 		    }
-		    *dest++ = (char) ((value & 0x80) ? '1' : '0');
 		}
 	    }
-
-	    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;
-	    static const char hexdigit[] = "0123456789abcdef";
-
-	    if (arg >= objc) {
-		DeleteScanNumberCache(numberCachePtr);
-		goto badIndex;
+	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;
 	    }
-	    if (count == BINARY_ALL) {
-		count = (length - offset)*2;
-	    } else {
-		if (count == BINARY_NOCOUNT) {
-		    count = 1;
-		}
-		if (count > (length - offset)*2) {
+	    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;
 		}
-	    }
-	    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 {
-			value = *src++;
+		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;
+
+			/*
+			 * Trim trailing nulls and spaces, if necessary.
+			 */
+
+			if (cmd == 'A') {
+			    while (size > 0) {
+				if (src[size-1] != '\0' && src[size-1] != ' ') {
+				    break;
+				}
+				size--;
+			    }
+			}
+			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;
 		    }
-		    *dest++ = hexdigit[value & 0xf];
-		}
-	    } else {
-		for (i = 0; i < count; i++) {
-		    if (i % 2) {
-			value <<= 4;
-		    } else {
-			value = *src++;
+		    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;
+		    }
+		    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;
+			    }
+			    if (count > (length - offset)*2) {
+				goto done;
+			    }
+			}
+			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];
+			    }
+			} 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;
+			}
+			offset += (count + 1) / 2;
+			break;
+		    }
+		    case 'c': {
+			size = 1;
+			goto scanNumber;
+		    }
+		    case 's':
+		    case 'S': {
+			size = 2;
+			goto scanNumber;
+		    }
+		    case 'i':
+		    case 'I': {
+			size = 4;
+			goto scanNumber;
+		    }
+		    case 'w':
+		    case 'W': {
+			size = 8;
+			goto scanNumber;
+		    }
+		    case 'f': {
+			size = sizeof(float);
+			goto scanNumber;
+		    }
+		    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;
+			} 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;
+			}
+
+			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;
+		    }
+		    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;
 		    }
-		    *dest++ = hexdigit[(value >> 4) & 0xf];
 		}
 	    }
 
-	    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;
-		}
-		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;
-		}
-		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;
-	    }
+	    /*
+	     * Set the result to the last position of the cursor.
+	     */
 
-	    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:
+	    done:
+	    Tcl_ResetResult(interp);
+	    Tcl_SetLongObj(Tcl_GetObjResult(interp), arg - 4);
 	    DeleteScanNumberCache(numberCachePtr);
-	    errorString = str;
-	    goto badField;
+	    break;
 	}
     }
-
-    /*
-     * Set the result to the last position of the cursor.
-     */
-
- done:
-    Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 3));
-    DeleteScanNumberCache(numberCachePtr);
-
     return TCL_OK;
 
- badCount:
+    badValue:
+    Tcl_ResetResult(interp);
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "expected ", errorString,
+	    " string but got \"", errorValue, "\" instead", NULL);
+    return TCL_ERROR;
+
+    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];
@@ -1590,7 +1365,7 @@ BinaryScanCmd(
 	return TCL_ERROR;
     }
 
- error:
+    error:
     Tcl_AppendResult(interp, errorString, NULL);
     return TCL_ERROR;
 }
@@ -1600,15 +1375,15 @@ BinaryScanCmd(
  *
  * 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.
@@ -1617,11 +1392,10 @@ BinaryScanCmd(
  */
 
 static int
-GetFormatSpec(
-    const 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 */
+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. */
 {
     /*
      * Skip any leading blanks.
@@ -1645,17 +1419,13 @@ GetFormatSpec(
 
     *cmdPtr = **formatPtr;
     (*formatPtr)++;
-    if (**formatPtr == 'u') {
-	(*formatPtr)++;
-	*flagsPtr |= BINARY_UNSIGNED;
-    }
     if (**formatPtr == '*') {
 	(*formatPtr)++;
-	*countPtr = BINARY_ALL;
+	(*countPtr) = BINARY_ALL;
     } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
-	*countPtr = strtoul(*formatPtr, (char **) formatPtr, 10);
+	(*countPtr) = strtoul(*formatPtr, formatPtr, 10);
     } else {
-	*countPtr = BINARY_NOCOUNT;
+	(*countPtr) = BINARY_NOCOUNT;
     }
     return 1;
 }
@@ -1663,193 +1433,13 @@ GetFormatSpec(
 /*
  *----------------------------------------------------------------------
  *
- * 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 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.
@@ -1858,313 +1448,247 @@ CopyNumber(
  */
 
 static int
-FormatNumber(
-    Tcl_Interp *interp,		/* Current interpreter, used to report
+FormatNumber(interp, type, src, cursorPtr)
+    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 'q':
-    case 'Q':
-	/*
-	 * 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) {
-	    if (src->typePtr != &tclDoubleType) {
-		return TCL_ERROR;
-	    }
-	    dvalue = src->internalRep.doubleValue;
-	}
-	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
-	*cursorPtr += sizeof(double);
-	return TCL_OK;
-
     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.
+	 * For floating point types, we need to copy the data using
+	 * memcpy to avoid alignment issues.
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    if (src->typePtr != &tclDoubleType) {
-		return TCL_ERROR;
-	    }
-	    dvalue = src->internalRep.doubleValue;
+	    return TCL_ERROR;
 	}
+	if (type == 'd') {
+	    /*
+	     * Can't just memcpy() here. [Bug 1116542]
+	     */
 
-	/*
-	 * 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;
+	    CopyNumber(&dvalue, *cursorPtr, sizeof(double));
+	    *cursorPtr += sizeof(double);
 	} else {
-	    fvalue = (float) dvalue;
+	    float fvalue;
+
+	    /*
+	     * 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;
+	    }
+	    memcpy((VOID *) *cursorPtr, (VOID *) &fvalue, sizeof(float));
+	    *cursorPtr += sizeof(float);
 	}
-	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
-	*cursorPtr += sizeof(float);
 	return TCL_OK;
 
 	/*
-	 * 64-bit integer values.
+	 * Next cases separate from other integer cases because we
+	 * need a different API to get a wide.
 	 */
     case 'w':
     case 'W':
-    case 'm':
 	if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (NeedReversing(type)) {
-	    *(*cursorPtr)++ = UCHAR(wvalue);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 32);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 40);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 48);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 56);
+	if (type == 'w') {
+	    *(*cursorPtr)++ = (unsigned char) wvalue;
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
 	} else {
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 56);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 48);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 40);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 32);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
-	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
-	    *(*cursorPtr)++ = UCHAR(wvalue);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
+	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
+	    *(*cursorPtr)++ = (unsigned char) wvalue;
 	}
 	return TCL_OK;
-
-	/*
-	 * 32-bit integer values.
-	 */
-    case 'i':
-    case 'I':
-    case 'n':
-	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (NeedReversing(type)) {
-	    *(*cursorPtr)++ = UCHAR(value);
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
-	    *(*cursorPtr)++ = UCHAR(value >> 16);
-	    *(*cursorPtr)++ = UCHAR(value >> 24);
-	} else {
-	    *(*cursorPtr)++ = UCHAR(value >> 24);
-	    *(*cursorPtr)++ = UCHAR(value >> 16);
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
-	    *(*cursorPtr)++ = UCHAR(value);
-	}
-	return TCL_OK;
-
-	/*
-	 * 16-bit integer values.
-	 */
-    case 's':
-    case 'S':
-    case 't':
-	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+    default:
+	if (Tcl_GetLongFromObj(interp, src, &value) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (NeedReversing(type)) {
-	    *(*cursorPtr)++ = UCHAR(value);
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
-	} else {
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
-	    *(*cursorPtr)++ = UCHAR(value);
-	}
-	return TCL_OK;
-
-	/*
-	 * 8-bit integer values.
-	 */
-    case 'c':
-	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') {
+	    *(*cursorPtr)++ = (unsigned char) value;
+	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
+	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
+	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
+	} else if (type == 'I') {
+	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
+	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
+	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
+	    *(*cursorPtr)++ = (unsigned char) value;
 	}
-	*(*cursorPtr)++ = UCHAR(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(
-    unsigned char *buffer,	/* Buffer to scan number from. */
-    int type,			/* Format character from "binary scan" */
-    int flags,			/* Format field flags */
-    Tcl_HashTable **numberCachePtrPtr)
+ScanNumber(buffer, type, numberCachePtrPtr)
+    unsigned char *buffer;	/* Buffer to scan number from. */
+    int type;			/* Format character from "binary scan" */
+    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. This practice is disabled if the BINARY_UNSIGNED flag is set.
+     * needed.
      */
 
     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];
-	if (!(flags & BINARY_UNSIGNED)) {
+	    value = buffer[0];
 	    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 't':
-	if (NeedReversing(type)) {
+	case 's':
 	    value = (long) (buffer[0] + (buffer[1] << 8));
-	} else {
+	    goto shortValue;
+	case 'S':
 	    value = (long) (buffer[1] + (buffer[0] << 8));
-	}
-	if (!(flags & BINARY_UNSIGNED)) {
+	    shortValue:
 	    if (value & 0x8000) {
 		value |= -0x10000;
 	    }
-	}
-	goto returnNumericObject;
-
-	/*
-	 * 32-bit numeric values.
-	 */
+	    goto returnNumericObject;
 
-    case 'i':
-    case 'I':
-    case 'n':
-	if (NeedReversing(type)) {
-	    value = (long) (buffer[0]
+	case 'i':
+	    value = (long) (buffer[0] 
 		    + (buffer[1] << 8)
 		    + (buffer[2] << 16)
-		    + (((long)buffer[3]) << 24));
-	} else {
+		    + (buffer[3] << 24));
+	    goto intValue;
+	case 'I':
 	    value = (long) (buffer[3]
 		    + (buffer[2] << 8)
 		    + (buffer[1] << 16)
-		    + (((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) 1)<<31)) && (value > 0)) {
-	    value -= (((unsigned) 1)<<31);
-	    value -= (((unsigned) 1)<<31);
-	}
-
-    returnNumericObject:
-	if (*numberCachePtrPtr == NULL) {
-	    return Tcl_NewLongObj(value);
-	} else {
-	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
-	    register Tcl_HashEntry *hPtr;
-	    int isNew;
+		    + (buffer[0] << 24));
+	    intValue:
+	    /*
+	     * Check to see if the value was sign extended properly on
+	     * systems where an int is more than 32-bits.
+	     */
 
-	    hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
-	    if (!isNew) {
-		return Tcl_GetHashValue(hPtr);
+	    if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
+		value -= (((unsigned int)1)<<31);
+		value -= (((unsigned int)1)<<31);
 	    }
-	    if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
-		register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
+	    returnNumericObject:
+	    if (*numberCachePtrPtr == NULL) {
+		return Tcl_NewLongObj(value);
+	    } else {
+		register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
+		register Tcl_HashEntry *hPtr;
+		int isNew;
 
-		Tcl_IncrRefCount(objPtr);
-		Tcl_SetHashValue(hPtr, objPtr);
-		return objPtr;
+		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);
+
+		    Tcl_IncrRefCount(objPtr);
+		    Tcl_SetHashValue(hPtr, (ClientData) objPtr);
+		    return objPtr;
+		}
 	    }
 
 	    /*
-	     * 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.
+	     * Do not cache wide values; they are already too large to
+	     * use as keys.
 	     */
-
-	    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])
+	case 'w':
+	    uwvalue =  ((Tcl_WideUInt) buffer[0])
 		    | (((Tcl_WideUInt) buffer[1]) << 8)
 		    | (((Tcl_WideUInt) buffer[2]) << 16)
 		    | (((Tcl_WideUInt) buffer[3]) << 24)
@@ -2172,8 +1696,9 @@ ScanNumber(
 		    | (((Tcl_WideUInt) buffer[5]) << 40)
 		    | (((Tcl_WideUInt) buffer[6]) << 48)
 		    | (((Tcl_WideUInt) buffer[7]) << 56);
-	} else {
-	    uwvalue = ((Tcl_WideUInt) buffer[7])
+	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
+	case 'W':
+	    uwvalue =  ((Tcl_WideUInt) buffer[7])
 		    | (((Tcl_WideUInt) buffer[6]) << 8)
 		    | (((Tcl_WideUInt) buffer[5]) << 16)
 		    | (((Tcl_WideUInt) buffer[4]) << 24)
@@ -2181,42 +1706,23 @@ ScanNumber(
 		    | (((Tcl_WideUInt) buffer[2]) << 40)
 		    | (((Tcl_WideUInt) buffer[1]) << 48)
 		    | (((Tcl_WideUInt) buffer[0]) << 56);
-	}
-	if (flags & BINARY_UNSIGNED) {
-	    Tcl_Obj *bigObj = NULL;
-	    mp_int big;
+	    return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);
 
-	    TclBNInitBignumFromWideUInt(&big, uwvalue);
-	    bigObj = Tcl_NewBignumObj(&big);
-	    return bigObj;
+	    /*
+	     * 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);
 	}
-	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;
 }
@@ -2225,7 +1731,7 @@ ScanNumber(
  *----------------------------------------------------------------------
  *
  * DeleteScanNumberCache --
- *
+ * 
  *	Deletes the hash table acting as a scan number cache.
  *
  * Results:
@@ -2238,11 +1744,10 @@ ScanNumber(
  */
 
 static void
-DeleteScanNumberCache(
-    Tcl_HashTable *numberCachePtr)
-				/* Pointer to the hash table, or NULL (when
-				 * the cache has already been deleted due to
-				 * overflow.) */
+DeleteScanNumberCache(numberCachePtr)
+    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;
@@ -2253,7 +1758,7 @@ DeleteScanNumberCache(
 
     hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
     while (hEntry != NULL) {
-	register Tcl_Obj *value = Tcl_GetHashValue(hEntry);
+	register Tcl_Obj *value = (Tcl_Obj *) Tcl_GetHashValue(hEntry);
 
 	if (value != NULL) {
 	    Tcl_DecrRefCount(value);
@@ -2262,490 +1767,3 @@ DeleteScanNumberCache(
     }
     Tcl_DeleteHashTable(numberCachePtr);
 }
-
-/*
- * ----------------------------------------------------------------------
- *
- * NOTES --
- *
- *	Some measurements show that it is faster to use a table to to perform
- *	uuencode and base64 value encoding than to calculate the output (at
- *	least on intel P4 arch).
- *
- *	Conversely using a lookup table for the decoding is slower than just
- *	calculating the values. We therefore use the fastest of each method.
- *
- *	Presumably this has to do with the size of the tables. The base64
- *	decode table is 255 bytes while the encode table is only 65 bytes. The
- *	choice likely depends on CPU memory cache sizes.
- */
-
-/*
- *----------------------------------------------------------------------
- *
- * BinaryEncodeHex --
- *
- *	Implement the [binary encode hex] binary encoding. clientData must be
- *	a table to convert values to hexadecimal digits.
- *
- * Results:
- *	Interp result set to an encoded byte array object
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BinaryEncodeHex(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *resultObj = NULL;
-    unsigned char *data = NULL;
-    unsigned char *cursor = NULL;
-    const char *digits = clientData;
-    int offset = 0, count = 0;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "data");
-	return TCL_ERROR;
-    }
-
-    TclNewObj(resultObj);
-    data = Tcl_GetByteArrayFromObj(objv[1], &count);
-    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
-    for (offset = 0; offset < count; ++offset) {
-	*cursor++ = digits[((data[offset] >> 4) & 0x0f)];
-	*cursor++ = digits[(data[offset] & 0x0f)];
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BinaryDecodeHex --
- *
- *	Implement the [binary decode hex] binary encoding.
- *
- * Results:
- *	Interp result set to an decoded byte array object
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BinaryDecodeHex(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *resultObj = NULL;
-    unsigned char *data, *datastart, *dataend;
-    unsigned char *begin, *cursor, c;
-    int i, index, value, size, count = 0, cut = 0, strict = 0;
-    enum {OPT_STRICT };
-    static const char *const optStrings[] = { "-strict", NULL };
-
-    if (objc < 2 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "data");
-	return TCL_ERROR;
-    }
-    for (i = 1; i < objc-1; ++i) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
-		TCL_EXACT, &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch (index) {
-	case OPT_STRICT:
-	    strict = 1;
-	    break;
-	}
-    }
-
-    TclNewObj(resultObj);
-    datastart = data = (unsigned char *)
-	    TclGetStringFromObj(objv[objc-1], &count);
-    dataend = data + count;
-    size = (count + 1) / 2;
-    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
-    while (data < dataend) {
-	value = 0;
-	for (i=0 ; i<2 ; i++) {
-	    if (data < dataend) {
-		c = *data++;
-
-		if (!isxdigit((int) c)) {
-		    if (strict || !isspace(c)) {
-			goto badChar;
-		    }
-		    i--;
-		    continue;
-		}
-		value <<= 4;
-		c -= '0';
-		if (c > 9) {
-		    c += ('0' - 'A') + 10;
-		}
-		if (c > 16) {
-		    c += ('A' - 'a');
-		}
-		value |= (c & 0xf);
-	    } else {
-		value <<= 4;
-		cut++;
-	    }
-	}
-	*cursor++ = UCHAR(value);
-	value = 0;
-    }
-    if (cut > size) {
-	cut = size;
-    }
-    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-
-  badChar:
-    TclDecrRefCount(resultObj);
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "invalid hexadecimal digit \"%c\" at position %d",
-	    c, (int) (data - datastart - 1)));
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BinaryEncode64 --
- *
- *	This implements a generic 6 bit binary encoding. Input is broken into
- *	6 bit chunks and a lookup table passed in via clientData is used to
- *	turn these values into output characters. This is used to implement
- *	base64 and uuencode binary encodings.
- *
- * Results:
- *	Interp result set to an encoded byte array object
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-#define OUTPUT(c) \
-    do {						\
-	*cursor++ = (c);				\
-	outindex++;					\
-	if (maxlen > 0 && cursor != limit) {		\
-	    if (outindex == maxlen) {			\
-		memcpy(cursor, wrapchar, wrapcharlen);	\
-		cursor += wrapcharlen;			\
-		outindex = 0;				\
-	    }						\
-	}						\
-	if (cursor > limit) {				\
-	    Tcl_Panic("limit hit");			\
-	}						\
-    } while (0)
-
-static int
-BinaryEncode64(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *resultObj;
-    unsigned char *data, *cursor, *limit;
-    const char *digits = clientData;
-    int maxlen = 0;
-    const char *wrapchar = "\n";
-    int wrapcharlen = 1;
-    int offset, i, index, size, outindex = 0, count = 0;
-    enum {OPT_MAXLEN, OPT_WRAPCHAR };
-    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
-
-    if (objc < 2 || objc%2 != 0) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-maxlen len? ?-wrapchar char? data");
-	return TCL_ERROR;
-    }
-    for (i = 1; i < objc-1; i += 2) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
-		TCL_EXACT, &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch (index) {
-	case OPT_MAXLEN:
-	    if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    break;
-	case OPT_WRAPCHAR:
-	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
-	    if (wrapcharlen == 0) {
-		maxlen = 0;
-	    }
-	    break;
-	}
-    }
-
-    resultObj = Tcl_NewObj();
-    data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
-    if (count > 0) {
-	size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
-	if (maxlen > 0 && size > maxlen) {
-	    int adjusted = size + (wrapcharlen * (size / maxlen));
-
-	    if (size % maxlen == 0) {
-		adjusted -= wrapcharlen;
-	    }
-	    size = adjusted;
-	}
-	cursor = Tcl_SetByteArrayLength(resultObj, size);
-	limit = cursor + size;
-	for (offset = 0; offset < count; offset+=3) {
-	    unsigned char d[3] = {0, 0, 0};
-
-	    for (i = 0; i < 3 && offset+i < count; ++i) {
-		d[i] = data[offset + i];
-	    }
-	    OUTPUT(digits[d[0] >> 2]);
-	    OUTPUT(digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
-	    if (offset+1 < count) {
-		OUTPUT(digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
-	    } else {
-		OUTPUT(digits[64]);
-	    }
-	    if (offset+2 < count) {
-		OUTPUT(digits[d[2] & 0x3f]);
-	    } else {
-		OUTPUT(digits[64]);
-	    }
-	}
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-#undef OUTPUT
-
-/*
- *----------------------------------------------------------------------
- *
- * BinaryDecodeUu --
- *
- *	Decode a uuencoded string.
- *
- * Results:
- *	Interp result set to an byte array object
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BinaryDecodeUu(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *resultObj = NULL;
-    unsigned char *data, *datastart, *dataend;
-    unsigned char *begin, *cursor;
-    int i, index, size, count = 0, cut = 0, strict = 0;
-    char c;
-    enum {OPT_STRICT };
-    static const char *const optStrings[] = { "-strict", NULL };
-
-    if (objc < 2 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "data");
-	return TCL_ERROR;
-    }
-    for (i = 1; i < objc-1; ++i) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
-		TCL_EXACT, &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch (index) {
-	case OPT_STRICT:
-	    strict = 1;
-	    break;
-	}
-    }
-
-    TclNewObj(resultObj);
-    datastart = data = (unsigned char *)
-	    TclGetStringFromObj(objv[objc-1], &count);
-    dataend = data + count;
-    size = ((count + 3) & ~3) * 3 / 4;
-    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
-    while (data < dataend) {
-	char d[4] = {0, 0, 0, 0};
-
-	for (i=0 ; i<4 ; i++) {
-	    if (data < dataend) {
-		d[i] = c = *data++;
-		if (c < 33 || c > 96) {
-		    if (strict || !isspace(UCHAR(c))) {
-			goto badUu;
-		    }
-		    i--;
-		    continue;
-		}
-	    } else {
-		cut++;
-	    }
-	}
-	if (cut > 3) {
-	    cut = 3;
-	}
-	*cursor++ = (((d[0] - 0x20) & 0x3f) << 2)
-		| (((d[1] - 0x20) & 0x3f) >> 4);
-	*cursor++ = (((d[1] - 0x20) & 0x3f) << 4)
-		| (((d[2] - 0x20) & 0x3f) >> 2);
-	*cursor++ = (((d[2] - 0x20) & 0x3f) << 6)
-		| (((d[3] - 0x20) & 0x3f));
-    }
-    if (cut > size) {
-	cut = size;
-    }
-    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-
-  badUu:
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "invalid uuencode character \"%c\" at position %d",
-	    c, (int) (data - datastart - 1)));
-    TclDecrRefCount(resultObj);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BinaryDecode64 --
- *
- *	Decode a base64 encoded string.
- *
- * Results:
- *	Interp result set to an byte array object
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BinaryDecode64(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *resultObj = NULL;
-    unsigned char *data, *datastart, *dataend, c;
-    unsigned char *begin = NULL;
-    unsigned char *cursor = NULL;
-    int strict = 0;
-    int i, index, size, cut = 0, count = 0;
-    enum {OPT_STRICT };
-    static const char *const optStrings[] = { "-strict", NULL };
-
-    if (objc < 2 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "data");
-	return TCL_ERROR;
-    }
-    for (i = 1; i < objc-1; ++i) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
-		TCL_EXACT, &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch (index) {
-	case OPT_STRICT:
-	    strict = 1;
-	    break;
-	}
-    }
-
-    TclNewObj(resultObj);
-    datastart = data = (unsigned char *)
-	    TclGetStringFromObj(objv[objc-1], &count);
-    dataend = data + count;
-    size = ((count + 3) & ~3) * 3 / 4;
-    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
-    while (data < dataend) {
-	unsigned long value = 0;
-
-	for (i=0 ; i<4 ; i++) {
-	    if (data < dataend) {
-		c = *data++;
-
-		if (c >= 'A' && c <= 'Z') {
-		    value = (value << 6) | ((c - 'A') & 0x3f);
-		} else if (c >= 'a' && c <= 'z') {
-		    value = (value << 6) | ((c - 'a' + 26) & 0x3f);
-		} else if (c >= '0' && c <= '9') {
-		    value = (value << 6) | ((c - '0' + 52) & 0x3f);
-		} else if (c == '+') {
-		    value = (value << 6) | 0x3e;
-		} else if (c == '/') {
-		    value = (value << 6) | 0x3f;
-		} else if (c == '=') {
-		    value <<= 6;
-		    if (cut < 2) {
-			cut++;
-		    }
-		} else {
-		    if (strict || !isspace(c)) {
-			goto bad64;
-		    }
-		    i--;
-		    continue;
-		}
-	    } else {
-		value <<= 6;
-		cut++;
-	    }
-	}
-	*cursor++ = UCHAR((value >> 16) & 0xff);
-	*cursor++ = UCHAR((value >> 8) & 0xff);
-	*cursor++ = UCHAR(value & 0xff);
-    }
-    if (cut > size) {
-	cut = size;
-    }
-    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-
-  bad64:
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "invalid base64 character \"%c\" at position %d",
-	    (char) c, (int) (data - datastart - 1)));
-    TclDecrRefCount(resultObj);
-    return TCL_ERROR;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
-
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 5b5a0d6..e81eaea 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -1,31 +1,25 @@
 /*
  * 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
 
-#undef Tcl_Alloc
-#undef Tcl_Free
-#undef Tcl_Realloc
-#undef Tcl_AttemptAlloc
-#undef Tcl_AttemptRealloc
-
 #ifdef TCL_MEM_DEBUG
 
 /*
@@ -34,39 +28,40 @@
  */
 
 typedef struct MemTag {
-    int refCount;		/* Number of mem_headers referencing this
-				 * tag. */
-    char string[1];		/* 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) ((TclOffset(MemTag, string) + 1) + bytesInString))
+#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;
+    CONST char *file;
     long length;
     int line;
     unsigned char low_guard[LOW_GUARD_SIZE];
 				/* 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 */
@@ -74,16 +69,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 \
@@ -91,25 +86,25 @@ static struct mem_header *allocHead = NULL;  /* List of allocated structures */
 
 static int total_mallocs = 0;
 static int total_frees = 0;
-static size_t current_bytes_malloced = 0;
-static size_t maximum_bytes_malloced = 0;
+static int current_bytes_malloced = 0;
+static int 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;
@@ -119,11 +114,10 @@ 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;
 
@@ -131,27 +125,26 @@ static int ckallocInit = 0;
  * Prototypes for procedures defined in this file:
  */
 
-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);
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * 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(void)
+TclInitDbCkalloc()
 {
     if (!ckallocInit) {
 	ckallocInit = 1;
@@ -163,40 +156,29 @@ TclInitDbCkalloc(void)
  *----------------------------------------------------------------------
  *
  * TclDumpMemoryInfo --
- *
- *	Display the global memory management statistics.
+ *     Display the global memory management statistics.
  *
  *----------------------------------------------------------------------
  */
-
-int
-TclDumpMemoryInfo(ClientData clientData, int flags)
+void
+TclDumpMemoryInfo(outFile)
+    FILE *outFile;
 {
-    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, "%s", buf);
-    } else {
-	/* Assume objPtr to append to */
-	Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
-    }
-    return 1;
+    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);
 }
 
+
 /*
  *----------------------------------------------------------------------
  *
@@ -215,68 +197,67 @@ TclDumpMemoryInfo(ClientData clientData, int flags)
  */
 
 static void
-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 */
+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 */
 {
     unsigned char *hiPtr;
-    size_t idx;
-    int guard_failed = FALSE;
+    int   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", (int)idx, byte,
+            fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", idx, byte,
 		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
-	}
+        }
     }
     if (guard_failed) {
-	TclDumpMemoryInfo((ClientData) stderr, 0);
-	fprintf(stderr, "low guard failed at %lx, %s %d\n",
-		(long unsigned) memHeaderP->body, file, line);
-	fflush(stderr);			/* In case name pointer is bad. */
-	fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
+        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,
 		memHeaderP->file, memHeaderP->line);
-	Tcl_Panic("Memory validation failure");
+        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", (int)idx, byte,
+            fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", idx, byte,
 		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
-	}
+        }
     }
 
     if (guard_failed) {
-	TclDumpMemoryInfo((ClientData) stderr, 0);
-	fprintf(stderr, "high guard failed at %lx, %s %d\n",
-		(long unsigned) memHeaderP->body, file, line);
-	fflush(stderr);			/* In case name pointer is bad. */
-	fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
+        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",
 		memHeaderP->length, memHeaderP->file,
 		memHeaderP->line);
-	Tcl_Panic("Memory validation failure");
+        panic("Memory validation failure");
     }
 
     if (nukeGuards) {
-	memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
-	memset(hiPtr, 0, HIGH_GUARD_SIZE);
+        memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
+        memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE);
     }
 
 }
@@ -296,13 +277,10 @@ ValidateMemory(
  *
  *----------------------------------------------------------------------
  */
-
 void
-Tcl_ValidateAllMemory(
-    const char *file,		/* File from which Tcl_ValidateAllMemory was
-				 * called. */
-    int line)			/* Line number of call to
-				 * Tcl_ValidateAllMemory */
+Tcl_ValidateAllMemory (file, line)
+    CONST char  *file;	/* File from which Tcl_ValidateAllMemory was called */
+    int          line;	/* Line number of call to Tcl_ValidateAllMemory */
 {
     struct mem_header *memScanP;
 
@@ -311,7 +289,7 @@ Tcl_ValidateAllMemory(
     }
     Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
-	ValidateMemory(memScanP, file, line, FALSE);
+        ValidateMemory(memScanP, file, line, FALSE);
     }
     Tcl_MutexUnlock(ckallocMutexPtr);
 }
@@ -325,19 +303,17 @@ Tcl_ValidateAllMemory(
  *	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(
-    const char *fileName)	/* Name of the file to write info to */
+Tcl_DumpActiveMemory (fileName)
+    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;
@@ -350,18 +326,18 @@ Tcl_DumpActiveMemory(
 
     Tcl_MutexLock(ckallocMutexPtr);
     for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
-	address = &memScanP->body[0];
-	fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
-		(long unsigned) address,
-		(long unsigned) address + memScanP->length - 1,
-		memScanP->length, memScanP->file, memScanP->line,
-		(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
+        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);
 	(void) fputc('\n', fileP);
     }
     Tcl_MutexUnlock(ckallocMutexPtr);
 
     if (fileP != stderr) {
-	fclose(fileP);
+	fclose (fileP);
     }
     return TCL_OK;
 }
@@ -371,54 +347,53 @@ Tcl_DumpActiveMemory(
  *
  * 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(
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_DbCkalloc(size, file, line)
+    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((ClientData) stderr, 0);
-	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
+        fflush(stdout);
+        TclDumpMemoryInfo(stderr);
+        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(result, GUARD_VALUE,
+        memset ((VOID *) result, GUARD_VALUE,
 		size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     } else {
-	memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
-	memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+	memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+	memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
     }
     if (!ckallocInit) {
 	TclInitDbCkalloc();
@@ -434,57 +409,56 @@ Tcl_DbCkalloc(
     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);
-	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
+        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(
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_AttemptDbCkalloc(size, file, line)
+    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)) {
@@ -492,22 +466,22 @@ Tcl_AttemptDbCkalloc(
 		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     }
     if (result == NULL) {
-	fflush(stdout);
-	TclDumpMemoryInfo((ClientData) stderr, 0);
+        fflush(stdout);
+        TclDumpMemoryInfo(stderr);
 	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(result, GUARD_VALUE,
+        memset ((VOID *) result, GUARD_VALUE,
 		size + sizeof(struct mem_header) + HIGH_GUARD_SIZE);
     } else {
-	memset(result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
-	memset(result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
+	memset ((char *) result->low_guard, GUARD_VALUE, LOW_GUARD_SIZE);
+	memset (result->body + size, GUARD_VALUE, HIGH_GUARD_SIZE);
     }
     if (!ckallocInit) {
 	TclInitDbCkalloc();
@@ -523,99 +497,101 @@ Tcl_AttemptDbCkalloc(
     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);
-	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
+        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 Tcl_Panic.
+ *        Verify that the low and high guards are intact, and if so
+ *        then free the buffer else 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(
-    char *ptr,
-    const char *file,
-    int line)
+int
+Tcl_DbCkfree(ptr, file, line)
+    char       *ptr;
+    CONST char *file;
+    int         line;
 {
     struct mem_header *memp;
 
     if (ptr == NULL) {
-	return;
+	return 0;
     }
 
     /*
-     * 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(ptr, GUARD_VALUE, (size_t) memp->length);
+	memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
     }
 
     total_frees++;
@@ -632,18 +608,16 @@ Tcl_DbCkfree(
     /*
      * 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);
+
+    return 0;
 }
 
 /*
@@ -651,22 +625,21 @@ Tcl_DbCkfree(
  *
  * 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(
-    char *ptr,
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_DbCkrealloc(ptr, size, file, line)
+    char        *ptr;
+    unsigned int size;
+    CONST char  *file;
+    int          line;
 {
-    char *newPtr;
+    char *new;
     unsigned int copySize;
     struct mem_header *memp;
 
@@ -675,7 +648,8 @@ Tcl_DbCkrealloc(
     }
 
     /*
-     * 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);
@@ -684,20 +658,20 @@ Tcl_DbCkrealloc(
     if (copySize > (unsigned int) memp->length) {
 	copySize = memp->length;
     }
-    newPtr = Tcl_DbCkalloc(size, file, line);
-    memcpy(newPtr, ptr, (size_t) copySize);
+    new = Tcl_DbCkalloc(size, file, line);
+    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
     Tcl_DbCkfree(ptr, file, line);
-    return newPtr;
+    return new;
 }
-
+
 char *
-Tcl_AttemptDbCkrealloc(
-    char *ptr,
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_AttemptDbCkrealloc(ptr, size, file, line)
+    char        *ptr;
+    unsigned int size;
+    CONST char  *file;
+    int          line;
 {
-    char *newPtr;
+    char *new;
     unsigned int copySize;
     struct mem_header *memp;
 
@@ -706,7 +680,8 @@ Tcl_AttemptDbCkrealloc(
     }
 
     /*
-     * 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);
@@ -715,13 +690,13 @@ Tcl_AttemptDbCkrealloc(
     if (copySize > (unsigned int) memp->length) {
 	copySize = memp->length;
     }
-    newPtr = Tcl_AttemptDbCkalloc(size, file, line);
-    if (newPtr == NULL) {
+    new = Tcl_AttemptDbCkalloc(size, file, line);
+    if (new == NULL) {
 	return NULL;
     }
-    memcpy(newPtr, ptr, (size_t) copySize);
+    memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
     Tcl_DbCkfree(ptr, file, line);
-    return newPtr;
+    return new;
 }
 
 
@@ -730,8 +705,8 @@ Tcl_AttemptDbCkrealloc(
  *
  * 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.
@@ -742,38 +717,44 @@ Tcl_AttemptDbCkrealloc(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_Alloc
+#undef Tcl_Free
+#undef Tcl_Realloc
+#undef Tcl_AttemptAlloc
+#undef Tcl_AttemptRealloc
+
 char *
-Tcl_Alloc(
-    unsigned int size)
+Tcl_Alloc(size)
+    unsigned int size;
 {
     return Tcl_DbCkalloc(size, "unknown", 0);
 }
 
 char *
-Tcl_AttemptAlloc(
-    unsigned int size)
+Tcl_AttemptAlloc(size)
+    unsigned int size;
 {
     return Tcl_AttemptDbCkalloc(size, "unknown", 0);
 }
 
 void
-Tcl_Free(
-    char *ptr)
+Tcl_Free(ptr)
+    char *ptr;
 {
     Tcl_DbCkfree(ptr, "unknown", 0);
 }
 
 char *
-Tcl_Realloc(
-    char *ptr,
-    unsigned int size)
+Tcl_Realloc(ptr, size)
+    char *ptr;
+    unsigned int size;
 {
     return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
 }
 char *
-Tcl_AttemptRealloc(
-    char *ptr,
-    unsigned int size)
+Tcl_AttemptRealloc(ptr, size)
+    char *ptr;
+    unsigned int size;
 {
     return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
 }
@@ -782,9 +763,8 @@ Tcl_AttemptRealloc(
  *----------------------------------------------------------------------
  *
  * 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
@@ -796,98 +776,79 @@ Tcl_AttemptRealloc(
  *		memory validate on|off
  *
  * Results:
- *	Standard TCL results.
+ *     Standard TCL results.
  *
  *----------------------------------------------------------------------
  */
 	/* ARGSUSED */
 static int
-MemoryCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int argc,
-    const char *argv[])
+MemoryCmd (clientData, interp, argc, argv)
+    ClientData  clientData;
+    Tcl_Interp *interp;
+    int         argc;
+    CONST char  **argv;
 {
-    const char *fileName;
-    FILE *fileP;
+    CONST char *fileName;
     Tcl_DString buffer;
     int result;
     size_t len;
 
     if (argc < 2) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option [args..]\"", NULL);
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option [args..]\"", (char *) 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\"", NULL);
+        if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " ", argv[1], " file\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
 	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
 	if (fileName == NULL) {
 	    return TCL_ERROR;
 	}
-	result = Tcl_DumpActiveMemory(fileName);
+	result = Tcl_DumpActiveMemory (fileName);
 	Tcl_DStringFree(&buffer);
 	if (result != TCL_OK) {
-	    Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
+	    Tcl_AppendResult(interp, "error accessing ", argv[2],
+		    (char *) 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) {
-	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", (unsigned long)current_bytes_malloced,
-		"maximum packets allocated", maximum_malloc_packets,
-		"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
-	return TCL_OK;
+	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;
     }
     if (strcmp(argv[1],"init") == 0) {
-	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;
+        if (argc != 3) {
+            goto bad_suboption;
 	}
-	fileP = fopen(fileName, "w");
-	if (fileP == NULL) {
-	    Tcl_AppendResult(interp, "cannot open output file", NULL);
-	    return TCL_ERROR;
-	}
-	TclDbDumpActiveObjects(fileP);
-	fclose(fileP);
-	Tcl_DStringFree(&buffer);
-	return TCL_OK;
+        init_malloced_bodies = (strcmp(argv[2],"on") == 0);
+        return TCL_OK;
     }
     if (strcmp(argv[1],"onexit") == 0) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " onexit file\"", NULL);
+        if (argc != 3) {
+	    Tcl_AppendResult(interp, "wrong # args: should be \"",
+		    argv[0], " onexit file\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
 	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
@@ -902,7 +863,7 @@ MemoryCmd(
     if (strcmp(argv[1],"tag") == 0) {
 	if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " tag string\"", NULL);
+		    " tag string\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
 	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
@@ -915,43 +876,43 @@ MemoryCmd(
 	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, objs, onexit, "
-	    "tag, trace, trace_on_at_malloc, or validate", NULL);
+	    "\": should be active, break_on_malloc, info, init, onexit, ",
+	    "tag, trace, trace_on_at_malloc, or validate", (char *) NULL);
     return TCL_ERROR;
 
-  argError:
+argError:
     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-	    " ", argv[1], " count\"", NULL);
+	    " ", argv[1], " count\"", (char *) NULL);
     return TCL_ERROR;
 
-  bad_suboption:
+bad_suboption:
     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-	    " ", argv[1], " on|off\"", NULL);
+	    " ", argv[1], " on|off\"", (char *) NULL);
     return TCL_ERROR;
 }
 
@@ -960,9 +921,10 @@ MemoryCmd(
  *
  * 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.
@@ -974,15 +936,15 @@ MemoryCmd(
  */
 
 static int
-CheckmemCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Interpreter for evaluation. */
-    int argc,			/* Number of arguments. */
-    const char *argv[])		/* String values of arguments. */
+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. */
 {
     if (argc != 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" fileName\"", NULL);
+		" fileName\"", (char *) NULL);
 	return TCL_ERROR;
     }
     tclMemDumpFileName = dumpFile;
@@ -995,7 +957,8 @@ CheckmemCmd(
  *
  * Tcl_InitMemory --
  *
- *	Create the "memory" and "checkmem" commands in the given interpreter.
+ *	Create the "memory" and "checkmem" commands in the given
+ *	interpreter.
  *
  * Results:
  *	None.
@@ -1007,13 +970,14 @@ CheckmemCmd(
  */
 
 void
-Tcl_InitMemory(
-    Tcl_Interp *interp)		/* Interpreter in which commands should be
-				 * added */
+Tcl_InitMemory(interp)
+    Tcl_Interp *interp;	/* Interpreter in which commands should be added */
 {
     TclInitDbCkalloc();
-    Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL);
-    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
+    Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
 }
 
 
@@ -1030,50 +994,47 @@ Tcl_InitMemory(
  *----------------------------------------------------------------------
  *
  * 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(
-    unsigned int size)
+Tcl_Alloc (size)
+    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) {
-	Tcl_Panic("unable to alloc %u bytes", size);
+	panic("unable to alloc %u bytes", size);
     }
     return result;
 }
 
 char *
-Tcl_DbCkalloc(
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_DbCkalloc(size, file, line)
+    unsigned int size;
+    CONST char  *file;
+    int          line;
 {
     char *result;
 
     result = (char *) TclpAlloc(size);
 
     if ((result == NULL) && size) {
-	fflush(stdout);
-	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
+        fflush(stdout);
+        panic("unable to alloc %u bytes, %s line %d", size, file, line);
     }
     return result;
 }
@@ -1082,16 +1043,15 @@ Tcl_DbCkalloc(
  *----------------------------------------------------------------------
  *
  * 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(
-    unsigned int size)
+Tcl_AttemptAlloc (size)
+    unsigned int size;
 {
     char *result;
 
@@ -1100,57 +1060,57 @@ Tcl_AttemptAlloc(
 }
 
 char *
-Tcl_AttemptDbCkalloc(
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_AttemptDbCkalloc(size, file, line)
+    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(
-    char *ptr,
-    unsigned int size)
+Tcl_Realloc(ptr, size)
+    char *ptr;
+    unsigned int size;
 {
     char *result;
 
     result = TclpRealloc(ptr, size);
 
     if ((result == NULL) && size) {
-	Tcl_Panic("unable to realloc %u bytes", size);
+	panic("unable to realloc %u bytes", size);
     }
     return result;
 }
 
 char *
-Tcl_DbCkrealloc(
-    char *ptr,
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_DbCkrealloc(ptr, size, file, line)
+    char        *ptr;
+    unsigned int size;
+    CONST char  *file;
+    int          line;
 {
     char *result;
 
     result = (char *) TclpRealloc(ptr, size);
 
     if ((result == NULL) && size) {
-	fflush(stdout);
-	Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);
+        fflush(stdout);
+        panic("unable to realloc %u bytes, %s line %d", size, file, line);
     }
     return result;
 }
@@ -1159,17 +1119,16 @@ Tcl_DbCkrealloc(
  *----------------------------------------------------------------------
  *
  * 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(
-    char *ptr,
-    unsigned int size)
+Tcl_AttemptRealloc(ptr, size)
+    char *ptr;
+    unsigned int size;
 {
     char *result;
 
@@ -1178,11 +1137,11 @@ Tcl_AttemptRealloc(
 }
 
 char *
-Tcl_AttemptDbCkrealloc(
-    char *ptr,
-    unsigned int size,
-    const char *file,
-    int line)
+Tcl_AttemptDbCkrealloc(ptr, size, file, line)
+    char        *ptr;
+    unsigned int size;
+    CONST char  *file;
+    int          line;
 {
     char *result;
 
@@ -1194,65 +1153,64 @@ Tcl_AttemptDbCkrealloc(
  *----------------------------------------------------------------------
  *
  * 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(
-    char *ptr)
+Tcl_Free (ptr)
+    char *ptr;
 {
     TclpFree(ptr);
 }
 
-void
-Tcl_DbCkfree(
-    char *ptr,
-    const char *file,
-    int line)
+int
+Tcl_DbCkfree(ptr, file, line)
+    char       *ptr;
+    CONST char *file;
+    int         line;
 {
     TclpFree(ptr);
+    return 0;
 }
 
 /*
  *----------------------------------------------------------------------
  *
  * 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(
-    Tcl_Interp *interp)
+Tcl_InitMemory(interp)
+    Tcl_Interp *interp;
 {
 }
 
 int
-Tcl_DumpActiveMemory(
-    const char *fileName)
+Tcl_DumpActiveMemory(fileName)
+    CONST char *fileName;
 {
     return TCL_OK;
 }
 
 void
-Tcl_ValidateAllMemory(
-    const char *file,
-    int line)
+Tcl_ValidateAllMemory(file, line)
+    CONST char *file;
+    int         line;
 {
 }
 
-int
-TclDumpMemoryInfo(ClientData clientData, int flags)
+void
+TclDumpMemoryInfo(outFile)
+    FILE *outFile;
 {
-    return 1;
 }
 
 #endif	/* TCL_MEM_DEBUG */
@@ -1262,22 +1220,23 @@ TclDumpMemoryInfo(ClientData clientData, int flags)
  *
  * 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(void)
+TclFinalizeMemorySubsystem()
 {
 #ifdef TCL_MEM_DEBUG
     if (tclMemDumpFileName != NULL) {
@@ -1285,15 +1244,12 @@ TclFinalizeMemorySubsystem(void)
     } else if (onExitMemDumpFileName != NULL) {
 	Tcl_DumpActiveMemory(onExitMemDumpFileName);
     }
-
     Tcl_MutexLock(ckallocMutexPtr);
-
     if (curTagPtr != NULL) {
 	TclpFree((char *) curTagPtr);
 	curTagPtr = NULL;
     }
     allocHead = NULL;
-
     Tcl_MutexUnlock(ckallocMutexPtr);
 #endif
 
@@ -1301,13 +1257,3 @@ TclFinalizeMemorySubsystem(void)
     TclFinalizeAllocSubsystem();
 #endif
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
- * End:
- */
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 7fa4017..2c00a07 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1,136 +1,23 @@
-/*
+/* 
  * 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"
 
 /*
- * 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 *const 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.
+ * The date parsing stuff uses lexx and has tons o statics.
  */
 
 TCL_DECLARE_MUTEX(clockMutex)
@@ -139,1900 +26,366 @@ TCL_DECLARE_MUTEX(clockMutex)
  * Function prototypes for local procedures in this file:
  */
 
-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 }
-};
+static int		FormatClock _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_WideInt clockVal, int useGMT,
+			    char *format));
 
 /*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
  *
- * TclClockInit --
+ * Tcl_ClockObjCmd --
  *
- *	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).
+ *	This procedure is invoked to process the "clock" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
- *	None.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	Installs the commands and creates the client data
+ *	See the user documentation.
  *
- *----------------------------------------------------------------------
- */
-
-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 NUL. */
-    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 = ckalloc(sizeof(ClockClientData));
-    data->refCount = 0;
-    data->literals = 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.
-     */
-
-#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
-    memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
-    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 = 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
-ClockGetdatefieldsObjCmd(
-    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 = clientData;
-    Tcl_Obj *const *literals = data->literals;
-    int changeover;
-
-    /*
-     * Check params.
-     */
-
-    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;
-    }
-
-    /*
-     * 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;
-    }
-
-    /*
-     * 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 */
+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. */
 {
-    TclDateFields fields;
-    Tcl_Obj *dict;
-    ClockClientData *data = clientData;
-    Tcl_Obj *const *literals = data->literals;
-    Tcl_Obj *fieldPtr;
-    int changeover;
-    int copied = 0;
-    int status;
-    int era = 0;
-
-    /*
-     * Check params.
-     */
+    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};
 
-    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) {
+    resultPtr = Tcl_GetObjResult(interp);
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
 	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 = 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) {
+    if (Tcl_GetIndexFromObj(interp, objv[1], switches, "option", 0, &index)
+	    != 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;
+    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;
 	    }
-	}
-	if (!found) {
-	    if (nHave == 8) {
-		Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
+	    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());
 	    }
-	    have[nHave++] = fields->tzOffset;
+	    return TCL_OK;
 	}
-	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.
- *
- *----------------------------------------------------------------------
- */
-
-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;
-
-    /*
-     * Convert the given time to a date.
-     */
-
-    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);
-
-    /*
-     * Convert the date/time to a 'struct tm'.
-     */
-
-    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;
-
-    /*
-     * Get local time. It is rumored that mktime is not thread safe on some
-     * platforms, so seize a mutex before attempting this.
-     */
-
-    TzsetIfNecessary();
-    Tcl_MutexLock(&clockMutex);
-    errno = 0;
-    fields->seconds = (Tcl_WideInt) mktime(&timeVal);
-    localErrno = errno;
-    Tcl_MutexUnlock(&clockMutex);
-
-    /*
-     * 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConvertUTCToLocal --
- *
- *	Converts a time (in a TclDateFields structure) from UTC to local time.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	Populates the 'tzName' and 'tzOffset' fields.
- *
- *----------------------------------------------------------------------
- */
 
-static int
-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 */
-{
-    int rowc;			/* Number of rows in tzdata */
-    Tcl_Obj **rowv;		/* Pointers to the rows */
+	case COMMAND_FORMAT:			/* format */
+	    if ((objc < 3) || (objc > 7)) {
+		wrongFmtArgs:
+		Tcl_WrongNumArgs(interp, 2, objv,
+			"clockval ?-format string? ?-gmt boolean?");
+		return TCL_ERROR;
+	    }
 
-    /*
-     * Unpack the tz data.
-     */
+	    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;
+	    }
 
-    if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
-	return TCL_ERROR;
-    }
+	    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;
+	    }
 
-    /*
-     * Special case: If the time zone is :localtime, the tzdata will be empty.
-     * Use 'localtime' to convert the time to local
-     */
+	    if (baseObjPtr != NULL) {
+		if (Tcl_GetWideIntFromObj(interp, baseObjPtr,
+					  &baseClock) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    } else {
+		baseClock = TclpGetSeconds();
+	    }
 
-    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.
- *
- *----------------------------------------------------------------------
- */
+	    if (useGMT) {
+		zone = -50000; /* Force GMT */
+	    } else {
+		zone = TclpGetTimeZone(baseClock);
+	    }
 
-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 */
+	    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);
 
-    /*
-     * Look up the nearest transition time.
-     */
+	    Tcl_SetWideIntObj(resultPtr, clockVal);
+	    return TCL_OK;
 
-    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;
+	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. */
     }
-
-    /*
-     * Convert the time.
-     */
-
-    fields->tzName = cellv[3];
-    Tcl_IncrRefCount(fields->tzName);
-    fields->localSeconds = fields->seconds + fields->tzOffset;
-    return TCL_OK;
 }
 
 /*
- *----------------------------------------------------------------------
+ *-----------------------------------------------------------------------------
  *
- * ConvertUTCToLocalUsingC --
+ * FormatClock --
  *
- *	Converts UTC to localtime in cases where the local time zone is not
- *	determinable, using the C 'localtime' function to do it.
+ *      Formats a time value based on seconds into a human readable
+ *	string.
  *
  * Results:
- *	Returns a standard Tcl result.
+ *      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.
+ *      None.
  *
- *----------------------------------------------------------------------
+ *-----------------------------------------------------------------------------
  */
 
 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 */
+FormatClock(interp, clockVal, useGMT, format)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    Tcl_WideInt clockVal;	       	/* Time in seconds. */
+    int useGMT;				/* Boolean */
+    char *format;			/* Format string */
 {
-    int l;
-    int u;
-    Tcl_Obj *compObj;
-    Tcl_WideInt compVal;
+    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
 
+#ifdef HAVE_TZSET
     /*
-     * Examine the first row to make sure we're in bounds.
+     * Some systems forgot to call tzset in localtime, make sure its done.
      */
+    static int  calledTzset = 0;
 
-    if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
-	    || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
-	return NULL;
+    Tcl_MutexLock(&clockMutex);
+    if (!calledTzset) {
+        tzset();
+        calledTzset = 1;
     }
+    Tcl_MutexUnlock(&clockMutex);
+#endif
 
     /*
-     * Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it
-     * anyway.
+     * If the user gave us -format "", just return now
      */
-
-    if (tick < compVal) {
-	return rowv[0];
+    if (*format == '\0') {
+	return TCL_OK;
     }
 
+#if !defined(HAVE_TM_ZONE) && !defined(WIN32)
     /*
-     * Binary-search to find the transition.
+     * 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.
      */
 
-    l = 0;
-    u = rowc-1;
-    while (l < u) {
-	int m = (l + u + 1) / 2;
+    Tcl_MutexLock( &clockMutex );
+    if (useGMT) {
+        CONST char *varValue;
 
-	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;
+        varValue = Tcl_GetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
+        if (varValue != NULL) {
+	    savedTZEnv = strcpy(ckalloc(strlen(varValue) + 1), varValue);
+        } else {
+            savedTZEnv = NULL;
 	}
+        Tcl_SetVar2(interp, "env", "TZ", "GMT0", TCL_GLOBAL_ONLY);
+        savedTimeZone = timezone;
+        timezone = 0;
+        tzset();
     }
-    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;
-
-    /*
-     * 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.
-     */
-
-    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);
+#endif
 
+    tclockVal = (time_t) clockVal;
+    timeDataPtr = TclpGetDate((TclpTime_t) &tclockVal, useGMT);
+    
     /*
-     * 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
+     * Make a guess at the upper limit on the substituted string size
+     * based on the number of percents in the string.
      */
 
-    if (fields->julianDay < temp.julianDay) {
-	if (temp.era == BCE) {
-	    temp.iso8601Year += 1;
+    for (bufSize = 1, p = format; *p != '\0'; p++) {
+	if (*p == '%') {
+	    bufSize += 40;
+	    if (p[1] == 'c') {
+		bufSize += 226;
+	    }
 	} else {
-	    temp.iso8601Year -= 1;
+	    bufSize++;
 	}
-	GetJulianDayFromEraYearWeekDay(&temp, changeover);
     }
+    Tcl_DStringInit(&uniBuffer);
+    Tcl_UtfToExternalDString(NULL, format, -1, &uniBuffer);
+    Tcl_DStringInit(&buffer);
+    Tcl_DStringSetLength(&buffer, bufSize);
 
-    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'.
- *
- *----------------------------------------------------------------------
- */
-
-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 (jday >= changeover) {
-	/*
-	 * Gregorian calendar.
-	 */
-
-	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 */
-    TclDateFields firstWeek;
-
-    /*
-     * Find January 4 in the ISO8601 year, which will always be in week 1.
-     */
-
-    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, ym1, month, mm1, q, r, ym1o4, ym1o100, 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]
-		+ (365 * 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 */
-{
-    /*
-     * Get a thread-local buffer to hold the returned time.
-     */
-
-    struct tm *tmPtr = Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
-#ifdef HAVE_LOCALTIME_R
-    localtime_r(timePtr, tmPtr);
-#else
-    struct tm *sysTmPtr;
+    /* If we haven't locked the clock mutex up above, lock it now. */
 
+#if defined(HAVE_TM_ZONE) || defined(WIN32)
     Tcl_MutexLock(&clockMutex);
-    sysTmPtr = localtime(timePtr);
-    if (sysTmPtr == NULL) {
-	Tcl_MutexUnlock(&clockMutex);
-	return NULL;
-    }
-    memcpy(tmPtr, localtime(timePtr), sizeof(struct tm));
+#endif
+    result = TclpStrftime(buffer.string, (unsigned int) bufSize,
+	    Tcl_DStringValue(&uniBuffer), timeDataPtr, useGMT);
+#if defined(HAVE_TM_ZONE) || defined(WIN32)
     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 *const clicksSwitches[] = {
-	"-milliseconds", "-microseconds", NULL
-    };
-    enum ClicksSwitch {
-	CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
-    };
-    int index = CLICKS_NATIVE;
-    Tcl_Time now;
-    Tcl_WideInt clicks = 0;
-
-    switch (objc) {
-    case 1:
-	break;
-    case 2:
-	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0,
-		&index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	break;
-    default:
-	Tcl_WrongNumArgs(interp, 1, objv, "?-switch?");
-	return TCL_ERROR;
-    }
-
-    switch (index) {
-    case CLICKS_MILLIS:
-	Tcl_GetTime(&now);
-	clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
-	break;
-    case CLICKS_NATIVE:
-#ifdef TCL_WIDE_CLICKS
-	clicks = TclpGetWideClicks();
-#else
-	clicks = (Tcl_WideInt) TclpGetClicks();
+    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
-	break;
-    case CLICKS_MICROS:
-	Tcl_GetTime(&now);
-	clicks = ((Tcl_WideInt) now.sec * 1000000) + now.usec;
-	break;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
-    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 = clientData;
-    Tcl_Obj **litPtr = dataPtr->literals;
-    Tcl_Obj *results[3];	/* Format, locale and timezone */
-#define formatObj results[0]
-#define localeObj results[1]
-#define timezoneObj results[2]
-    int gmtFlag = 0;
-    static const char *const options[] = { /* Command line options expected */
-	"-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);
+    if (result == 0) {
+	/*
+	 * 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.
+	 */
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"bad format string \"", format, "\"", (char *) NULL);
 	return TCL_ERROR;
     }
-    if (gmtFlag) {
-	timezoneObj = litPtr[LIT_GMT];
-    }
 
     /*
-     * Return options as a list.
+     * Convert the time to UTF from external encoding [Bug: 3345]
      */
+    Tcl_DStringInit(&uniBuffer);
+    Tcl_ExternalToUtfDString(NULL, buffer.string, -1, &uniBuffer);
 
-    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;
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), uniBuffer.string, -1);
 
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-    Tcl_GetTime(&now);
-    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) now.sec));
+    Tcl_DStringFree(&uniBuffer);
+    Tcl_DStringFree(&buffer);
     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 = clientData;
-    int i;
-
-    data->refCount--;
-    if (data->refCount == 0) {
-	for (i = 0; i < LIT__END; ++i) {
-	    Tcl_DecrRefCount(data->literals[i]);
-	}
-	ckfree(data->literals);
-	ckfree(data);
-    }
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 70aef8d..63d9111 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1,103 +1,51 @@
-/*
+/* 
  * 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 2935503]: file mtime sets wrong time */
+#   define _USE_32BIT_TIME_T
+#endif
+
+#include <sys/stat.h>
 #include "tclInt.h"
+#include "tclPort.h"
 #include <locale.h>
 
 /*
- * The state structure used by [foreach]. Note that the actual structure has
- * all its working arrays appended afterwards so they can be allocated and
- * freed in a single step.
- */
-
-struct ForeachState {
-    Tcl_Obj *bodyPtr;		/* The script body of the command. */
-    int bodyIdx;		/* The argument index of the body. */
-    int j, maxj;		/* Number of loop iterations. */
-    int numLists;		/* Count of value lists. */
-    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. */
-};
-
-/*
  * Prototypes for local procedures defined in this file:
  */
 
-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 inline int	ForeachAssignments(Tcl_Interp *interp,
-			    struct ForeachState *statePtr);
-static inline void	ForeachCleanup(Tcl_Interp *interp,
-			    struct ForeachState *statePtr);
-static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-			    Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
-static const char *	GetTypeFromMode(int mode);
-static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
-			    Tcl_StatBuf *statPtr);
-static Tcl_NRPostProc	CatchObjCmdCallback;
-static Tcl_NRPostProc	ExprCallback;
-static Tcl_NRPostProc	ForSetupCallback;
-static Tcl_NRPostProc	ForCondCallback;
-static Tcl_NRPostProc	ForNextCallback;
-static Tcl_NRPostProc	ForPostNextCallback;
-static Tcl_NRPostProc	ForeachLoopStep;
-static Tcl_NRPostProc	EvalCmdErrMsg;
-
-static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
-static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
-static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
-static Tcl_ObjCmdProc FileAttrIsExistingCmd;
-static Tcl_ObjCmdProc FileAttrIsFileCmd;
-static Tcl_ObjCmdProc FileAttrIsOwnedCmd;
-static Tcl_ObjCmdProc FileAttrIsReadableCmd;
-static Tcl_ObjCmdProc FileAttrIsWritableCmd;
-static Tcl_ObjCmdProc FileAttrLinkStatCmd;
-static Tcl_ObjCmdProc FileAttrModifyTimeCmd;
-static Tcl_ObjCmdProc FileAttrSizeCmd;
-static Tcl_ObjCmdProc FileAttrStatCmd;
-static Tcl_ObjCmdProc FileAttrTypeCmd;
-static Tcl_ObjCmdProc FilesystemSeparatorCmd;
-static Tcl_ObjCmdProc FilesystemVolumesCmd;
-static Tcl_ObjCmdProc PathDirNameCmd;
-static Tcl_ObjCmdProc PathExtensionCmd;
-static Tcl_ObjCmdProc PathFilesystemCmd;
-static Tcl_ObjCmdProc PathJoinCmd;
-static Tcl_ObjCmdProc PathNativeNameCmd;
-static Tcl_ObjCmdProc PathNormalizeCmd;
-static Tcl_ObjCmdProc PathRootNameCmd;
-static Tcl_ObjCmdProc PathSplitCmd;
-static Tcl_ObjCmdProc PathTailCmd;
-static Tcl_ObjCmdProc PathTypeCmd;
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * 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.
@@ -110,11 +58,11 @@ static Tcl_ObjCmdProc PathTypeCmd;
 
 	/* ARGSUSED */
 int
-Tcl_BreakObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     if (objc != 1) {
 	Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -128,9 +76,8 @@ Tcl_BreakObjCmd(
  *
  * Tcl_CaseObjCmd --
  *
- *	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.
+ *	This procedure is invoked to process the "case" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -143,28 +90,28 @@ Tcl_BreakObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_CaseObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     register int i;
     int body, result, caseObjc;
-    const char *stringPtr, *arg;
-    Tcl_Obj *const *caseObjv;
+    char *string, *arg;
+    Tcl_Obj *CONST *caseObjv;
     Tcl_Obj *armPtr;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"string ?in? ?pattern body ...? ?default body?");
+		"string ?in? patList body ... ?default body?");
 	return TCL_ERROR;
     }
 
-    stringPtr = TclGetString(objv[1]);
+    string = Tcl_GetString(objv[1]);
     body = -1;
 
-    arg = TclGetString(objv[2]);
+    arg = Tcl_GetString(objv[2]);
     if (strcmp(arg, "in") == 0) {
 	i = 3;
     } else {
@@ -174,35 +121,36 @@ Tcl_CaseObjCmd(
     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;
-
-	TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
+	
+	Tcl_ListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
 	caseObjv = newObjv;
     }
 
     for (i = 0;  i < caseObjc;  i += 2) {
 	int patObjc, j;
-	const char **patObjv;
-	const char *pat;
+	CONST char **patObjv;
+	char *pat;
 	unsigned char *p;
 
-	if (i == caseObjc-1) {
+	if (i == (caseObjc - 1)) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "extra case pattern with no body", NULL);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "extra case pattern with no body", -1);
 	    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 = TclGetString(caseObjv[i]);
+	pat = Tcl_GetString(caseObjv[i]);
 	for (p = (unsigned char *) pat; *p != '\0'; p++) {
 	    if (isspace(*p) || (*p == '\\')) {	/* INTL: ISO space, UCHAR */
 		break;
@@ -212,16 +160,17 @@ Tcl_CaseObjCmd(
 	    if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
 		body = i + 1;
 	    }
-	    if (Tcl_StringMatch(stringPtr, pat)) {
+	    if (Tcl_StringMatch(string, 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);
@@ -229,25 +178,29 @@ Tcl_CaseObjCmd(
 	    return result;
 	}
 	for (j = 0; j < patObjc; j++) {
-	    if (Tcl_StringMatch(stringPtr, patObjv[j])) {
+	    if (Tcl_StringMatch(string, patObjv[j])) {
 		body = i + 1;
 		break;
 	    }
 	}
-	ckfree(patObjv);
+	ckfree((char *) patObjv);
 	if (j < patObjc) {
 	    break;
 	}
     }
 
-  match:
+    match:
     if (body != -1) {
 	armPtr = caseObjv[body - 1];
 	result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
 	if (result == TCL_ERROR) {
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (\"%.50s\" arm line %d)",
-		    TclGetString(armPtr), Tcl_GetErrorLine(interp)));
+	    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);
 	}
 	return result;
     }
@@ -264,7 +217,7 @@ Tcl_CaseObjCmd(
  *
  * 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:
@@ -278,89 +231,53 @@ Tcl_CaseObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_CatchObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRCatchObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRCatchObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *varNamePtr = NULL;
-    Tcl_Obj *optionVarNamePtr = NULL;
-    Interp *iPtr = (Interp *) interp;
+    int result;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
-    if ((objc < 2) || (objc > 4)) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"script ?resultVarName? ?optionVarName?");
+    if ((objc != 2) && (objc != 3)) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command ?varName?");
 	return TCL_ERROR;
     }
 
-    if (objc >= 3) {
+    if (objc == 3) {
 	varNamePtr = objv[2];
     }
-    if (objc == 4) {
-	optionVarNamePtr = objv[3];
-    }
-
-    TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
-	    varNamePtr, optionVarNamePtr, NULL);
-
-    /*
-     * TIP #280. Make invoking context available to caught script.
-     */
-
-    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
-}
-
-static int
-CatchObjCmdCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    int objc = PTR2INT(data[0]);
-    Tcl_Obj *varNamePtr = data[1];
-    Tcl_Obj *optionVarNamePtr = data[2];
-    int rewind = iPtr->execEnvPtr->rewind;
-
-    /*
-     * We disable catch in interpreters where the limit has been exceeded.
-     */
-
-    if (rewind || Tcl_LimitExceeded(interp)) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"catch\" body line %d)", Tcl_GetErrorLine(interp)));
-	return TCL_ERROR;
-    }
 
-    if (objc >= 3) {
-	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
-		Tcl_GetObjResult(interp), TCL_LEAVE_ERR_MSG)) {
+#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) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),  
+	            "couldn't save command result in variable", -1);
 	    return TCL_ERROR;
 	}
     }
-    if (objc == 4) {
-	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);
 
-	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
-		options, TCL_LEAVE_ERR_MSG)) {
-	    Tcl_DecrRefCount(options);
-	    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_SetObjResult(interp, Tcl_NewIntObj(result));
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), result);
     return TCL_OK;
 }
 
@@ -369,8 +286,8 @@ CatchObjCmdCallback(
  *
  * 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.
@@ -383,11 +300,11 @@ CatchObjCmdCallback(
 
 	/* ARGSUSED */
 int
-Tcl_CdObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *dir;
     int result;
@@ -400,7 +317,7 @@ Tcl_CdObjCmd(
     if (objc == 2) {
 	dir = objv[1];
     } else {
-	TclNewLiteralStringObj(dir, "~");
+	dir = Tcl_NewStringObj("~",1);
 	Tcl_IncrRefCount(dir);
     }
     if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
@@ -409,7 +326,7 @@ Tcl_CdObjCmd(
 	result = Tcl_FSChdir(dir);
 	if (result != TCL_OK) {
 	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
-		    TclGetString(dir), "\": ", Tcl_PosixError(interp), NULL);
+		    Tcl_GetString(dir), "\": ", Tcl_PosixError(interp), (char *) NULL);
 	    result = TCL_ERROR;
 	}
     }
@@ -438,11 +355,11 @@ Tcl_CdObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_ConcatObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     if (objc >= 2) {
 	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
@@ -453,14 +370,14 @@ Tcl_ConcatObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * 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.
@@ -473,11 +390,11 @@ Tcl_ConcatObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_ContinueObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     if (objc != 1) {
 	Tcl_WrongNumArgs(interp, 1, objv, NULL);
@@ -503,25 +420,29 @@ Tcl_ContinueObjCmd(
  */
 
 int
-Tcl_EncodingObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    int index;
+    int index, length;
+    Tcl_Encoding encoding;
+    char *string;
+    Tcl_DString ds;
+    Tcl_Obj *resultPtr;
 
-    static const char *const optionStrings[] = {
-	"convertfrom", "convertto", "dirs", "names", "system",
+    static CONST char *optionStrings[] = {
+	"convertfrom", "convertto", "names", "system",
 	NULL
     };
     enum options {
-	ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
+	ENC_CONVERTFROM, ENC_CONVERTTO, 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) {
@@ -529,121 +450,79 @@ Tcl_EncodingObjCmd(
     }
 
     switch ((enum options) index) {
-    case ENC_CONVERTTO:
-    case ENC_CONVERTFROM: {
-	Tcl_Obj *data;
-	Tcl_DString ds;
-	Tcl_Encoding encoding;
-	int length;
-	const 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) {
+	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");
 		return TCL_ERROR;
 	    }
-	    data = objv[3];
-	} else {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
-	    return TCL_ERROR;
-	}
-
-	if ((enum options) index == ENC_CONVERTFROM) {
-	    /*
-	     * Treat the string as binary data.
-	     */
-
-	    stringPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
-	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);
-
-	    /*
-	     * Note that we cannot use Tcl_DStringResult here because it will
-	     * truncate the string at the first null byte.
-	     */
-
-	    Tcl_SetObjResult(interp, TclDStringToObj(&ds));
-	} else {
-	    /*
-	     * Store the result as binary data.
-	     */
-
-	    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);
-	}
+	    
+	    if ((enum options) index == ENC_CONVERTFROM) {
+		/*
+		 * Treat the string as binary data.
+		 */
+
+		string = (char *) Tcl_GetByteArrayFromObj(data, &length);
+		Tcl_ExternalToUtfDString(encoding, string, length, &ds);
+
+		/*
+		 * Note that we cannot use Tcl_DStringResult here because
+		 * it will truncate the string at the first null byte.
+		 */
+
+		Tcl_SetStringObj(Tcl_GetObjResult(interp),
+			Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+		Tcl_DStringFree(&ds);
+	    } else {
+		/*
+		 * Store the result as binary data.
+		 */
+
+		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_FreeEncoding(encoding);
-	break;
-    }
-    case ENC_DIRS:
-	return EncodingDirsObjCmd(dummy, interp, objc-1, objv+1);
-    case ENC_NAMES:
-	if (objc > 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
+	    Tcl_FreeEncoding(encoding);
+	    break;
 	}
-	Tcl_GetEncodingNames(interp);
-	break;
-    case ENC_SYSTEM:
-	if (objc > 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
-	    return TCL_ERROR;
+	case ENC_NAMES: {
+	    if (objc > 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, NULL);
+		return TCL_ERROR;
+	    }
+	    Tcl_GetEncodingNames(interp);
+	    break;
 	}
-	if (objc == 2) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    Tcl_GetEncodingName(NULL), -1));
-	} else {
-	    return Tcl_SetSystemEncoding(interp, TclGetString(objv[2]));
+	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;
 	}
-	break;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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. */
-{
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
-	return TCL_ERROR;
-    }
-    if (objc == 1) {
-	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
-	return TCL_OK;
     }
-    if (Tcl_SetEncodingSearchPath(objv[1]) == TCL_ERROR) {
-	Tcl_AppendResult(interp, "expected directory list but got \"",
-		TclGetString(objv[1]), "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
-		NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, objv[1]);
     return TCL_OK;
 }
 
@@ -652,8 +531,8 @@ EncodingDirsObjCmd(
  *
  * 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.
@@ -666,35 +545,36 @@ EncodingDirsObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_ErrorObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *options, *optName;
+    Interp *iPtr = (Interp *) interp;
+    char *info;
+    int infoLen;
 
     if ((objc < 2) || (objc > 4)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
 	return TCL_ERROR;
     }
-
-    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 >= 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;
+	}
     }
-
-    if (objc >= 4) {		/* Process the optional code argument */
-	TclNewLiteralStringObj(optName, "-errorcode");
-	Tcl_ListObjAppendElement(NULL, options, optName);
-	Tcl_ListObjAppendElement(NULL, options, objv[3]);
+    
+    if (objc == 4) {
+	Tcl_SetVar2Ex(interp, "errorCode", NULL, objv[3], TCL_GLOBAL_ONLY);
+	iPtr->flags |= ERROR_CODE_SET;
     }
-
+    
     Tcl_SetObjResult(interp, objv[1]);
-    return Tcl_SetReturnOptions(interp, options);
+    return TCL_ERROR;
 }
 
 /*
@@ -702,7 +582,7 @@ Tcl_ErrorObjCmd(
  *
  * 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:
@@ -715,69 +595,56 @@ Tcl_ErrorObjCmd(
  */
 
 	/* ARGSUSED */
-static int
-EvalCmdErrMsg(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    if (result == TCL_ERROR) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"eval\" body line %d)", Tcl_GetErrorLine(interp)));
-    }
-    return result;
-}
-
 int
-Tcl_EvalObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv);    
-}
-
-int
-TclNREvalObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
+    int result;
     register Tcl_Obj *objPtr;
-    Interp *iPtr = (Interp *) interp;
-    CmdFrame *invoker = NULL;
-    int word = 0;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
 	return TCL_ERROR;
     }
-
+    
     if (objc == 2) {
-	/*
-	 * TIP #280. Make argument location available to eval'd script.
-	 */
-
-	invoker = iPtr->cmdFramePtr;
-	word = 1;
-	objPtr = objv[1];
-	TclArgumentGet(interp, objPtr, &invoker, &word);
+#ifndef TCL_TIP280
+	result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
+#else
+	/* 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
     } 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.
-	 *
-	 * TIP #280. Make invoking context available to eval'd script, done
-	 * with the default values.
+	 * 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 */
+	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
+#endif
+    }
+    if (result == TCL_ERROR) {
+	char msg[32 + TCL_INTEGER_SPACE];
 
-	objPtr = Tcl_ConcatObj(objc-1, objv+1);
+	sprintf(msg, "\n    (\"eval\" body line %d)", interp->errorLine);
+	Tcl_AddObjErrorInfo(interp, msg, -1);
     }
-    TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
+    return result;
 }
 
 /*
@@ -785,8 +652,8 @@ TclNREvalObjCmd(
  *
  * 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.
@@ -799,11 +666,11 @@ TclNREvalObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_ExitObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int value;
 
@@ -811,7 +678,7 @@ Tcl_ExitObjCmd(
 	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
 	return TCL_ERROR;
     }
-
+    
     if (objc == 1) {
 	value = 0;
     } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
@@ -819,7 +686,7 @@ Tcl_ExitObjCmd(
     }
     Tcl_Exit(value);
     /*NOTREACHED*/
-    return TCL_OK;		/* Better not ever reach this! */
+    return TCL_OK;			/* Better not ever reach this! */
 }
 
 /*
@@ -831,8 +698,8 @@ Tcl_ExitObjCmd(
  *	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")
@@ -848,1250 +715,692 @@ Tcl_ExitObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_ExprObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRExprObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *resultPtr, *objPtr;
+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_Obj *resultPtr;
+    register char *bytes;
+    int length, i, result;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
 	return TCL_ERROR;
     }
 
-    TclNewObj(resultPtr);
-    Tcl_IncrRefCount(resultPtr);
     if (objc == 2) {
-	objPtr = objv[1];
-	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
-    } else {
-	objPtr = Tcl_ConcatObj(objc-1, objv+1);
-	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
+	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;
     }
 
-    return Tcl_NRExprObj(interp, objPtr, resultPtr);
-}
-
-static int
-ExprCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj *resultPtr = data[0];
-    Tcl_Obj *objPtr = data[1];
+    /*
+     * Create a new object holding the concatenated argument strings.
+     */
 
-    if (objPtr != NULL) {
-	Tcl_DecrRefCount(objPtr);
+    /*** 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);
     }
 
+    /*
+     * 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);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitFileCmd --
- *
- *	This function builds the "file" Tcl command ensemble. See the user
- *	documentation for details on what that ensemble 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.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
 
-Tcl_Command
-TclInitFileCmd(
-    Tcl_Interp *interp)
-{
     /*
-     * Note that most subcommands are unsafe because either they manipulate
-     * the native filesystem or because they reveal information about the
-     * native filesystem.
+     * Free allocated resources.
      */
-
-    static const EnsembleImplMap initMap[] = {
-	{"atime",	FileAttrAccessTimeCmd, NULL, NULL, NULL, 0},
-	{"attributes",	TclFileAttrsCmd, NULL, NULL, NULL, 0},
-	{"channels",	TclChannelNamesCmd, NULL, NULL, NULL, 0},
-	{"copy",	TclFileCopyCmd, NULL, NULL, NULL, 0},
-	{"delete",	TclFileDeleteCmd, NULL, NULL, NULL, 0},
-	{"dirname",	PathDirNameCmd, NULL, NULL, NULL, 0},
-	{"executable",	FileAttrIsExecutableCmd, NULL, NULL, NULL, 0},
-	{"exists",	FileAttrIsExistingCmd, NULL, NULL, NULL, 0},
-	{"extension",	PathExtensionCmd, NULL, NULL, NULL, 0},
-	{"isdirectory",	FileAttrIsDirectoryCmd, NULL, NULL, NULL, 0},
-	{"isfile",	FileAttrIsFileCmd, NULL, NULL, NULL, 0},
-	{"join",	PathJoinCmd, NULL, NULL, NULL, 0},
-	{"link",	TclFileLinkCmd, NULL, NULL, NULL, 0},
-	{"lstat",	FileAttrLinkStatCmd, NULL, NULL, NULL, 0},
-	{"mtime",	FileAttrModifyTimeCmd, NULL, NULL, NULL, 0},
-	{"mkdir",	TclFileMakeDirsCmd, NULL, NULL, NULL, 0},
-	{"nativename",	PathNativeNameCmd, NULL, NULL, NULL, 0},
-	{"normalize",	PathNormalizeCmd, NULL, NULL, NULL, 0},
-	{"owned",	FileAttrIsOwnedCmd, NULL, NULL, NULL, 0},
-	{"pathtype",	PathTypeCmd, NULL, NULL, NULL, 0},
-	{"readable",	FileAttrIsReadableCmd, NULL, NULL, NULL, 0},
-	{"readlink",	TclFileReadLinkCmd, NULL, NULL, NULL, 0},
-	{"rename",	TclFileRenameCmd, NULL, NULL, NULL, 0},
-	{"rootname",	PathRootNameCmd, NULL, NULL, NULL, 0},
-	{"separator",	FilesystemSeparatorCmd, NULL, NULL, NULL, 0},
-	{"size",	FileAttrSizeCmd, NULL, NULL, NULL, 0},
-	{"split",	PathSplitCmd, NULL, NULL, NULL, 0},
-	{"stat",	FileAttrStatCmd, NULL, NULL, NULL, 0},
-	{"system",	PathFilesystemCmd, NULL, NULL, NULL, 0},
-	{"tail",	PathTailCmd, NULL, NULL, NULL, 0},
-	{"tempfile",	TclFileTemporaryCmd, NULL, NULL, NULL, 0},
-	{"type",	FileAttrTypeCmd, NULL, NULL, NULL, 0},
-	{"volumes",	FilesystemVolumesCmd, NULL, NULL, NULL, 0},
-	{"writable",	FileAttrIsWritableCmd, NULL, NULL, NULL, 0},
-	{NULL, NULL, NULL, NULL, NULL, 0}
-    };
-    return TclMakeEnsemble(interp, "file", initMap);
+    
+    Tcl_DecrRefCount(objPtr);
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclMakeFileCommandSafe --
+ * Tcl_FileObjCmd --
  *
- *	This function hides the unsafe subcommands of the "file" Tcl command
- *	ensemble. It must only be called from TclHideUnsafeCommands.
+ *	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.
  *
  * Results:
  *	A standard Tcl result.
  *
  * Side effects:
- *	Adds commands to the table of hidden commands.
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-TclMakeFileCommandSafe(
-    Tcl_Interp *interp)
+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. */
 {
-    static const struct {
-	const char *cmdName;
-	int unsafe;
-    } unsafeInfo[] = {
-	{"atime",	 1},
-	{"attributes",	 1},
-	{"channels",	 0},
-	{"copy",	 1},
-	{"delete",	 1},
-	{"dirname",	 1},
-	{"executable",	 1},
-	{"exists",	 1},
-	{"extension",	 1},
-	{"isdirectory",	 1},
-	{"isfile",	 1},
-	{"join",	 0},
-	{"link",	 1},
-	{"lstat",	 1},
-	{"mtime",	 1},
-	{"mkdir",	 1},
-	{"nativename",	 1},
-	{"normalize",	 1},
-	{"owned",	 1},
-	{"pathtype",	 0},
-	{"readable",	 1},
-	{"readlink",	 1},
-	{"rename",	 1},
-	{"rootname",	 1},
-	{"separator",	 0},
-	{"size",	 1},
-	{"split",	 0},
-	{"stat",	 1},
-	{"system",	 0},
-	{"tail",	 1},
-	{"tempfile",	 1},
-	{"type",	 1},
-	{"volumes",	 1},
-	{"writable",	 1},
-	{NULL, 0}
-    };
-    int i;
-    Tcl_DString oldBuf, newBuf;
-
-    Tcl_DStringInit(&oldBuf);
-    Tcl_DStringAppend(&oldBuf, "::tcl::file::", -1);
-    Tcl_DStringInit(&newBuf);
-    Tcl_DStringAppend(&newBuf, "tcl:file:", -1);
-    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
-	if (unsafeInfo[i].unsafe) {
-	    const char *oldName, *newName;
-
-	    Tcl_DStringSetLength(&oldBuf, 13);
-	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
-	    Tcl_DStringSetLength(&newBuf, 9);
-	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
-	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
-		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
-		Tcl_Panic("problem making 'file %s' safe: %s",
-			unsafeInfo[i].cmdName,
-			Tcl_GetString(Tcl_GetObjResult(interp)));
-	    }
-	}
-    }
-    Tcl_DStringFree(&oldBuf);
-    Tcl_DStringFree(&newBuf);
-
-    /*
-     * Ugh. The [file] command is now actually safe, but it is assumed by
-     * scripts that it is not, which messes up security policies. [Bug
-     * 3211758]
-     */
+    int index;
 
-    if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
-	Tcl_Panic("problem making 'file' safe: %s",
-		Tcl_GetString(Tcl_GetObjResult(interp)));
-    }
-    return TCL_OK;
-}
-
 /*
- *----------------------------------------------------------------------
- *
- * FileAttrAccessTimeCmd --
- *
- *	This function is invoked to process the "file atime" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May update the access time on the file, if requested by the user.
- *
- *----------------------------------------------------------------------
+ * This list of constants should match the fileOption string array below.
  */
 
-static int
-FileAttrAccessTimeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-    struct utimbuf tval;
+    static CONST char *fileOptions[] = {
+	"atime",	"attributes",	"channels",	"copy",
+	"delete",
+	"dirname",	"executable",	"exists",	"extension",
+	"isdirectory",	"isfile",	"join",		"link",
+	"lstat",        "mtime",	"mkdir",	"nativename",	
+	"normalize",    "owned",
+	"pathtype",	"readable",	"readlink",	"rename",
+	"rootname",	"separator",    "size",		"split",	
+	"stat",         "system", 
+	"tail",		"type",		"volumes",	"writable",
+	(char *) 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_PATHTYPE,	FCMD_READABLE,	FCMD_READLINK,	FCMD_RENAME,
+	FCMD_ROOTNAME,	FCMD_SEPARATOR, FCMD_SIZE,	FCMD_SPLIT,	
+	FCMD_STAT,      FCMD_SYSTEM, 
+	FCMD_TAIL,	FCMD_TYPE,	FCMD_VOLUMES,	FCMD_WRITABLE
+    };
 
-    if (objc < 2 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
-	return TCL_ERROR;
+    if (objc < 2) {
+    	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+        return TCL_ERROR;
     }
-    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
-	return TCL_ERROR;
+    if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
+	    &index) != TCL_OK) {
+    	return TCL_ERROR;
     }
-    if (objc == 3) {
-	/*
-	 * Need separate variable for reading longs from an object on 64-bit
-	 * platforms. [Bug 698146]
-	 */
 
-	long newTime;
+    switch ((enum options) index) {
+    	case FCMD_ATIME: {
+	    Tcl_StatBuf buf;
+	    struct utimbuf tval;
 
-	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
-	    return TCL_ERROR;
+	    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;
+
+		if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		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;
+		}
+	    }
+	    Tcl_SetLongObj(Tcl_GetObjResult(interp), (long) buf.st_atime);
+	    return TCL_OK;
 	}
-
-	tval.actime = newTime;
-	tval.modtime = buf.st_mtime;
-
-	if (Tcl_FSUtime(objv[1], &tval) != 0) {
-	    Tcl_AppendResult(interp, "could not set access time for file \"",
-		    TclGetString(objv[1]), "\": ", Tcl_PosixError(interp),
-		    NULL);
-	    return TCL_ERROR;
+	case FCMD_ATTRIBUTES: {
+            return TclFileAttrsCmd(interp, objc, objv);
 	}
-
-	/*
-	 * 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[1], Tcl_FSStat, &buf) != TCL_OK) {
-	    return TCL_ERROR;
+	case FCMD_CHANNELS: {
+	    if ((objc < 2) || (objc > 3)) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+		return TCL_ERROR;
+	    }
+	    return Tcl_GetChannelNamesEx(interp,
+		    ((objc == 2) ? NULL : Tcl_GetString(objv[2])));
 	}
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_atime));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrModifyTimeCmd --
- *
- *	This function is invoked to process the "file mtime" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May update the modification time on the file, if requested by the
- *	user.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrModifyTimeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-    struct utimbuf tval;
-
-    if (objc < 2 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if (objc == 3) {
-	/*
-	 * Need separate variable for reading longs from an object on 64-bit
-	 * platforms. [Bug 698146]
-	 */
-
-	long newTime;
-
-	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
-	    return TCL_ERROR;
+	case FCMD_COPY: {
+	    return TclFileCopyCmd(interp, objc, objv);
+	}	    
+	case FCMD_DELETE: {
+	    return TclFileDeleteCmd(interp, objc, objv);
 	}
-
-	tval.actime = buf.st_atime;
-	tval.modtime = newTime;
-
-	if (Tcl_FSUtime(objv[1], &tval) != 0) {
-	    Tcl_AppendResult(interp, "could not set modification time for "
-		    "file \"", TclGetString(objv[1]), "\": ",
-		    Tcl_PosixError(interp), NULL);
-	    return TCL_ERROR;
+    	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
-	 * mtime - hopefully the same as the one we sent in.
-	 */
-
-	if (GetStatBuf(interp, objv[1], 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) buf.st_mtime));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrLinkStatCmd --
- *
- *	This function is invoked to process the "file lstat" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Writes to an array named by the user.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrLinkStatCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    return StoreStatData(interp, objv[2], &buf);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrStatCmd --
- *
- *	This function is invoked to process the "file stat" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Writes to an array named by the user.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrStatCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    return StoreStatData(interp, objv[2], &buf);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrTypeCmd --
- *
- *	This function is invoked to process the "file type" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrTypeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-	    GetTypeFromMode((unsigned short) buf.st_mode), -1));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrSizeCmd --
- *
- *	This function is invoked to process the "file size" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrSizeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrIsDirectoryCmd --
- *
- *	This function is invoked to process the "file isdirectory" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrIsDirectoryCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-    int value = 0;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
-	value = S_ISDIR(buf.st_mode);
-    }
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrIsExecutableCmd --
- *
- *	This function is invoked to process the "file executable" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrIsExecutableCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    return CheckAccess(interp, objv[1], X_OK);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrIsExistingCmd --
- *
- *	This function is invoked to process the "file exists" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	case FCMD_EXISTS: {
+	    if (objc != 3) {
+		goto only3Args;
+	    }
+	    return CheckAccess(interp, objv[2], F_OK);
+	}
+	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);
+	    }
+	    return TCL_OK;
+	}
+    	case FCMD_ISDIRECTORY: {
+	    int value;
+	    Tcl_StatBuf buf;
 
-static int
-FileAttrIsExistingCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    return CheckAccess(interp, objv[1], F_OK);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrIsFileCmd --
- *
- *	This function is invoked to process the "file isfile" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	    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);
+	    return TCL_OK;
+	}
+    	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_JOIN: {
+	    Tcl_Obj *resObj;
 
-static int
-FileAttrIsFileCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-    int value = 0;
+	    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) {
+		    /* 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) {
+		    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;
+		}
+	    } 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;
+		}
+	    }
+	    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) {
+		return TCL_ERROR;
+	    }
+	    varName = Tcl_GetString(objv[3]);
+	    return StoreStatData(interp, varName, &buf);
+	}
+	case FCMD_MTIME: {
+	    Tcl_StatBuf buf;
+	    struct utimbuf tval;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
-	value = S_ISREG(buf.st_mode);
-    }
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrIsOwnedCmd --
- *
- *	This function is invoked to process the "file owned" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	    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;
+
+		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;
+		}
+		/*
+		 * 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;
+		}
+	    }
+	    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;
 
-static int
-FileAttrIsOwnedCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_StatBuf buf;
-    int value = 0;
+	    if (objc != 3) {
+		goto only3Args;
+	    }
+	    fileName = Tcl_GetString(objv[2]);
+	    fileName = Tcl_TranslateFileName(interp, fileName, &ds);
+	    if (fileName == NULL) {
+		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 != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
-	/*
-	 * For Windows, there are no user ids associated with a file, so we
-	 * always return 1.
-	 *
-	 * TODO: use GetSecurityInfo to get the real owner of the file and
-	 * test for equivalence to the current user.
-	 */
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "filename");
+		return TCL_ERROR;
+	    }
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
-	value = 1;
+	    fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
+	    if (fileName == 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 and Macintosh, there are no user ids 
+		 * associated with a file, so we always return 1.
+		 */
+
+#if defined(__WIN32__) || defined(MAC_TCL) || defined(__CYGWIN__)
+		value = 1;
 #else
-	value = (geteuid() == buf.st_uid);
+		value = (geteuid() == buf.st_uid);
 #endif
-    }
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrIsReadableCmd --
- *
- *	This function is invoked to process the "file readable" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrIsReadableCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    return CheckAccess(interp, objv[1], R_OK);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FileAttrIsWritableCmd --
- *
- *	This function is invoked to process the "file writable" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-FileAttrIsWritableCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    return CheckAccess(interp, objv[1], W_OK);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathDirNameCmd --
- *
- *	This function is invoked to process the "file dirname" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathDirNameCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *dirPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_DIRNAME);
-    if (dirPtr == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, dirPtr);
-    Tcl_DecrRefCount(dirPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathExtensionCmd --
- *
- *	This function is invoked to process the "file extension" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathExtensionCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *dirPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_EXTENSION);
-    if (dirPtr == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, dirPtr);
-    Tcl_DecrRefCount(dirPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathRootNameCmd --
- *
- *	This function is invoked to process the "file root" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathRootNameCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *dirPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_ROOT);
-    if (dirPtr == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, dirPtr);
-    Tcl_DecrRefCount(dirPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathTailCmd --
- *
- *	This function is invoked to process the "file tail" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathTailCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *dirPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_TAIL);
-    if (dirPtr == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, dirPtr);
-    Tcl_DecrRefCount(dirPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathFilesystemCmd --
- *
- *	This function is invoked to process the "file system" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathFilesystemCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *fsInfo;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    fsInfo = Tcl_FSFileSystemInfo(objv[1]);
-    if (fsInfo == NULL) {
-	Tcl_SetResult(interp, "unrecognised path", TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
-		Tcl_GetString(objv[1]), NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, fsInfo);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathJoinCmd --
- *
- *	This function is invoked to process the "file join" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathJoinCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathNativeNameCmd --
- *
- *	This function is invoked to process the "file nativename" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathNativeNameCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_DString ds;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, TclDStringToObj(&ds));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathNormalizeCmd --
- *
- *	This function is invoked to process the "file normalize" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathNormalizeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *fileName;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    fileName = Tcl_FSGetNormalizedPath(interp, objv[1]);
-    if (fileName == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, fileName);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathSplitCmd --
- *
- *	This function is invoked to process the "file split" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PathSplitCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *res;
+	    }	    
+	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
+	    return TCL_OK;
+	}
+	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;
+	}
+    	case FCMD_READABLE: {
+	    if (objc != 3) {
+		goto only3Args;
+	    }
+	    return CheckAccess(interp, objv[2], R_OK);
+	}
+	case FCMD_READLINK: {
+	    Tcl_Obj *contents;
+		
+	    if (objc != 3) {
+		goto only3Args;
+	    }
+	    
+	    if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
+		return TCL_ERROR;
+	    }
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    res = Tcl_FSSplitPath(objv[1], NULL);
-    if (res == NULL) {
-	Tcl_AppendResult(interp, "could not read \"", TclGetString(objv[1]),
-		"\": no such file or directory", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
-		NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, res);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PathTypeCmd --
- *
- *	This function is invoked to process the "file pathtype" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	    contents = Tcl_FSLink(objv[2], NULL, 0);
 
-static int
-PathTypeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *typeName;
+	    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;
+	}
+	case FCMD_RENAME: {
+	    return TclFileRenameCmd(interp, objc, objv);
+	}
+	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;
+	}
+	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;
+		    case TCL_PLATFORM_MAC:
+			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;
+	}
+	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;
+	}
+	case FCMD_SPLIT: {
+	    if (objc != 3) {
+		goto only3Args;
+	    }
+	    Tcl_SetObjResult(interp, Tcl_FSSplitPath(objv[2], NULL));
+	    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);
+	}
+	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;
+	    }
+	}
+    	case FCMD_TAIL: {
+	    int splitElements;
+	    Tcl_Obj *splitPtr;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-    switch (Tcl_FSGetPathType(objv[1])) {
-    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:
-	/* Should be unreachable */
-	return TCL_OK;
-    }
-    Tcl_SetObjResult(interp, typeName);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FilesystemSeparatorCmd --
- *
- *	This function is invoked to process the "file separator" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	    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);
+	    }
 
-static int
-FilesystemSeparatorCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc < 1 || objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
-	return TCL_ERROR;
-    }
-    if (objc == 1) {
-	const char *separator = NULL; /* lint */
+	    /*
+	     * Return the last component, unless it is the only component,
+	     * and it is the root of an absolute path.
+	     */
 
-	switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX:
-	    separator = "/";
-	    break;
-	case TCL_PLATFORM_WINDOWS:
-	    separator = "\\";
-	    break;
+	    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);
+	    return TCL_OK;
 	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
-    } else {
-	Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);
+	case FCMD_TYPE: {
+	    Tcl_StatBuf buf;
 
-	if (separatorObj == NULL) {
-	    Tcl_SetResult(interp, "unrecognised path", TCL_STATIC);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
-		    Tcl_GetString(objv[1]), NULL);
-	    return TCL_ERROR;
+	    if (objc != 3) {
+	    	goto only3Args;
+	    }
+	    if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
+		    GetTypeFromMode((unsigned short) buf.st_mode), -1);
+	    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);
 	}
-	Tcl_SetObjResult(interp, separatorObj);
     }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FilesystemVolumesCmd --
- *
- *	This function is invoked to process the "file volumes" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
 
-static int
-FilesystemVolumesCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, Tcl_FSListVolumes());
-    return TCL_OK;
+    only3Args:
+    Tcl_WrongNumArgs(interp, 2, objv, "name");
+    return TCL_ERROR;
 }
 
 /*
@@ -2099,35 +1408,35 @@ FilesystemVolumesCmd(
  *
  * 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(
-    Tcl_Interp *interp,		/* Interp for status return. Must not be
+CheckAccess(interp, objPtr, mode)
+    Tcl_Interp *interp;		/* Interp for status return.  Must not be
 				 * NULL. */
-    Tcl_Obj *pathPtr,		/* Name of file to check. */
-    int mode)			/* Attribute to check; passed as argument to
+    Tcl_Obj *objPtr;		/* Name of file to check. */
+    int mode;			/* Attribute to check; passed as argument to
 				 * access(). */
 {
     int value;
-
-    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
+    
+    if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
 	value = 0;
     } else {
-	value = (Tcl_FSAccess(pathPtr, mode) == 0);
+	value = (Tcl_FSAccess(objPtr, mode) == 0);
     }
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), value);
 
     return TCL_OK;
 }
@@ -2137,14 +1446,14 @@ CheckAccess(
  *
  * 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.
@@ -2153,27 +1462,27 @@ CheckAccess(
  */
 
 static int
-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
+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
 				 * 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, pathPtr) != TCL_OK) {
+    
+    if (Tcl_FSConvertToPathType(interp, objPtr) != TCL_OK) {
 	return TCL_ERROR;
     }
 
-    status = statProc(pathPtr, statPtr);
-
+    status = (*statProc)(objPtr, statPtr);
+    
     if (status < 0) {
 	if (interp != NULL) {
 	    Tcl_AppendResult(interp, "could not read \"",
-		    TclGetString(pathPtr), "\": ",
-		    Tcl_PosixError(interp), NULL);
+		    Tcl_GetString(objPtr), "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
 	}
 	return TCL_ERROR;
     }
@@ -2185,13 +1494,13 @@ GetStatBuf(
  *
  * 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.
@@ -2200,59 +1509,56 @@ GetStatBuf(
  */
 
 static int
-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. */
+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. */
 {
-    Tcl_Obj *field, *value;
+    Tcl_Obj *var = Tcl_NewStringObj(varName, -1);
+    Tcl_Obj *field = Tcl_NewObj();
+    Tcl_Obj *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) \
-    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);
-
+    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));
     /*
-     * Watch out porters; the inode is meant to be an *unsigned* value, so the
-     * cast might fail when there isn't a real arithmetic '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("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));
+    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));
 #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;
 }
 
@@ -2261,7 +1567,8 @@ StoreStatData(
  *
  * 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.
@@ -2272,9 +1579,9 @@ StoreStatData(
  *----------------------------------------------------------------------
  */
 
-static const char *
-GetTypeFromMode(
-    int mode)
+static char *
+GetTypeFromMode(mode)
+    int mode;
 {
     if (S_ISREG(mode)) {
 	return "file";
@@ -2303,227 +1610,114 @@ GetTypeFromMode(
  *
  * 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.
- *
- * Notes:
- *	This command is split into a lot of pieces so that it can avoid doing
- *	reentrant TEBC calls. This makes things rather hard to follow, but
- *	here's the plan:
- *
- *	NR:	---------------_\
- *	Direct:	Tcl_ForObjCmd -> TclNRForObjCmd
- *					|
- *				ForSetupCallback
- *					|
- *	[while] ------------> TclNRForIterCallback <---------.
- *					|		     |
- *				 ForCondCallback	     |
- *					|		     |
- *				 ForNextCallback ------------|
- *					|		     |
- *			       ForPostNextCallback	     |
- *					|____________________|
+ *      See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_ForObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRForObjCmd, dummy, objc, objv);
-}
-
+        /* ARGSUSED */
 int
-TclNRForObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
-    ForIterData *iterPtr;
+    int result, value;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     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;
     }
 
-    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
-    iterPtr->cond = objv[2];
-    iterPtr->body = objv[4];
-    iterPtr->next = objv[3];
-    iterPtr->msg  = "\n    (\"for\" body line %d)";
-    iterPtr->word = 4;
-
-    TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);
-
-    /*
-     * TIP #280. Make invoking context available to initial script.
-     */
-
-    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
-}
-
-static int
-ForSetupCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    ForIterData *iterPtr = data[0];
-
+#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
     if (result != TCL_OK) {
-	if (result == TCL_ERROR) {
-	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
-	}
-	TclSmallFreeEx(interp, iterPtr);
-	return result;
+        if (result == TCL_ERROR) {
+            Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
+        }
+        return result;
     }
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
-    return TCL_OK;
-}
-
-int
-TclNRForIterCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    ForIterData *iterPtr = data[0];
-    Tcl_Obj *boolObj;
-
-    switch (result) {
-    case TCL_OK:
-    case TCL_CONTINUE:
+    while (1) {
 	/*
-	 * We need to reset the result before evaluating the expression.
-	 * Otherwise, any error message will be appended to the result of the
-	 * last evaluation.
+	 * We need to reset the result before passing it off to
+	 * Tcl_ExprBooleanObj.  Otherwise, any error message will be appended
+	 * to the result of the last evaluation.
 	 */
 
 	Tcl_ResetResult(interp);
-	TclNewObj(boolObj);
-	TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL,
-		NULL);
-	return Tcl_NRExprObj(interp, iterPtr->cond, boolObj);
-    case TCL_BREAK:
-	result = TCL_OK;
-	Tcl_ResetResult(interp);
-	break;
-    case TCL_ERROR:
-	Tcl_AppendObjToErrorInfo(interp,
-		Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp)));
-    }
-    TclSmallFreeEx(interp, iterPtr);
-    return result;
-}
-
-static int
-ForCondCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    ForIterData *iterPtr = data[0];
-    Tcl_Obj *boolObj = data[1];
-    int value;
-
-    if (result != TCL_OK) {
-	Tcl_DecrRefCount(boolObj);
-	TclSmallFreeEx(interp, iterPtr);
-	return result;
-    } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
-	Tcl_DecrRefCount(boolObj);
-	TclSmallFreeEx(interp, iterPtr);
-	return TCL_ERROR;
-    }
-    Tcl_DecrRefCount(boolObj);
-
-    if (value) {
-	/* TIP #280. */
-	if (iterPtr->next) {
-	    TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
-		    NULL);
-	} else {
-	    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
-		    NULL, NULL);
-	}
-	return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
-		iterPtr->word);
-    }
-    TclSmallFreeEx(interp, iterPtr);
-    return result;
-}
-
-static int
-ForNextCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    ForIterData *iterPtr = data[0];
-    Tcl_Obj *next = iterPtr->next;
-
-    if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
-	TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
-		NULL);
-
-	/*
-	 * TIP #280. Make invoking context available to next script.
-	 */
-
-	return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3);
+        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
+	if (result == TCL_BREAK) {
+            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;
     }
-
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
-    return result;
-}
-
-static int
-ForPostNextCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    ForIterData *iterPtr = data[0];
-
-    if ((result != TCL_BREAK) && (result != TCL_OK)) {
-	if (result == TCL_ERROR) {
-	    Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
-	    TclSmallFreeEx(interp, iterPtr);
-	}
-	return result;
+    if (result == TCL_OK) {
+        Tcl_ResetResult(interp);
     }
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
     return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ForeachObjCmd, TclNRForeachCmd --
+ * 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.
@@ -2536,25 +1730,45 @@ ForPostNextCallback(
 
 	/* ARGSUSED */
 int
-Tcl_ForeachObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    return Tcl_NRCallObjProc(interp, TclNRForeachCmd, dummy, objc, objv);
-}
+    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 */
+    Tcl_Obj *bodyPtr;
 
-int
-TclNRForeachCmd(
-    ClientData dummy,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    int numLists = (objc-2) / 2;
-    register struct ForeachState *statePtr;
-    int i, j, result;
+    /*
+     * 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
 
     if (objc < 4 || (objc%2 != 0)) {
 	Tcl_WrongNumArgs(interp, 1, objv,
@@ -2563,257 +1777,677 @@ TclNRForeachCmd(
     }
 
     /*
+     * Create the object argument array "argObjv". Make sure argObjv is
+     * large enough to hold the objc arguments.
+     */
+
+    if (objc > NUM_ARGS) {
+	argObjv = (Tcl_Obj **) ckalloc(objc * sizeof(Tcl_Obj *));
+    }
+    for (i = 0;  i < objc;  i++) {
+	argObjv[i] = objv[i];
+    }
+
+    /*
      * Manage numList parallel value lists.
-     * statePtr->argvList[i] is a value list counted by statePtr->argcList[i];
-     * statePtr->varvList[i] is the list of variables associated with the
-     *		value list;
-     * statePtr->varcList[i] is the number of variables associated with the
-     *		value list;
-     * statePtr->index[i] is the current pointer into the value list
-     *		statePtr->argvList[i].
-     *
-     * The setting up of all of these pointers is moderately messy, but allows
-     * the rest of this code to be simple and for us to use a single memory
-     * allocation for better performance.
+     * 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]
      */
 
-    statePtr = TclStackAlloc(interp,
-	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
-	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
-    memset(statePtr, 0,
-	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
-	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
-    statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
-    statePtr->argvList = statePtr->varvList + numLists;
-    statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists);
-    statePtr->aCopyList = statePtr->vCopyList + numLists;
-    statePtr->index = (int *) (statePtr->aCopyList + numLists);
-    statePtr->varcList = statePtr->index + numLists;
-    statePtr->argcList = statePtr->varcList + numLists;
-
-    statePtr->numLists = numLists;
-    statePtr->bodyPtr = objv[objc - 1];
-    statePtr->bodyIdx = objc - 1;
+    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;
+    }
 
     /*
-     * Break up the value lists and variable lists into elements.
+     * Break up the value lists and variable lists into elements
      */
 
-    for (i=0 ; i<numLists ; i++) {
-	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
-	if (statePtr->vCopyList[i] == NULL) {
-	    result = TCL_ERROR;
+    maxj = 0;
+    for (i = 0;  i < numLists;  i++) {
+	result = Tcl_ListObjGetElements(interp, argObjv[1+i*2],
+	        &varcList[i], &varvList[i]);
+	if (result != TCL_OK) {
 	    goto done;
 	}
-	TclListObjGetElements(NULL, statePtr->vCopyList[i],
-		&statePtr->varcList[i], &statePtr->varvList[i]);
-	if (statePtr->varcList[i] < 1) {
-	    Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH",
-		    "NEEDVARS", NULL);
+	if (varcList[i] < 1) {
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	            "foreach varlist is empty", -1);
 	    result = TCL_ERROR;
 	    goto done;
 	}
-
-	statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
-	if (statePtr->aCopyList[i] == NULL) {
-	    result = TCL_ERROR;
+	
+	result = Tcl_ListObjGetElements(interp, argObjv[2+i*2],
+	        &argcList[i], &argvList[i]);
+	if (result != TCL_OK) {
 	    goto done;
 	}
-	TclListObjGetElements(NULL, statePtr->aCopyList[i],
-		&statePtr->argcList[i], &statePtr->argvList[i]);
-
-	j = statePtr->argcList[i] / statePtr->varcList[i];
-	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
+	
+	j = argcList[i] / varcList[i];
+	if ((argcList[i] % varcList[i]) != 0) {
 	    j++;
 	}
-	if (j > statePtr->maxj) {
-	    statePtr->maxj = j;
+	if (j > maxj) {
+	    maxj = j;
 	}
     }
 
     /*
-     * If there is any work to do, assign the variables and set things going
-     * non-recursively.
+     * 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...)
+	     */
 
-    if (statePtr->maxj > 0) {
-	result = ForeachAssignments(interp, statePtr);
-	if (result == TCL_ERROR) {
-	    goto done;
+	    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++) {
+		int k = index[i]++;
+		Tcl_Obj *valuePtr, *varValuePtr;
+		
+		if (k < argcList[i]) {
+		    valuePtr = argvList[i][k];
+		} else {
+		    valuePtr = Tcl_NewObj(); /* empty string */
+		}
+		Tcl_IncrRefCount(valuePtr);
+		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v],
+			NULL, valuePtr, 0);
+		Tcl_DecrRefCount(valuePtr);
+		if (varValuePtr == NULL) {
+		    Tcl_ResetResult(interp);
+		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+			"couldn't set loop variable: \"",
+			Tcl_GetString(varvList[i][v]), "\"", (char *) NULL);
+		    result = TCL_ERROR;
+		    goto done;
+		}
+
+	    }
 	}
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
-	return TclNREvalObjEx(interp, objv[objc-1], 0,
-		((Interp *) interp)->cmdFramePtr, objc-1);
-    }
+#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
+	if (result != TCL_OK) {
+	    if (result == TCL_CONTINUE) {
+		result = TCL_OK;
+	    } else if (result == TCL_BREAK) {
+		result = TCL_OK;
+		break;
+	    } else if (result == TCL_ERROR) {
+                char msg[32 + TCL_INTEGER_SPACE];
 
-    /*
-     * This cleanup stage is only used when an error occurs during setup or if
-     * there is no work to do.
-     */
+		sprintf(msg, "\n    (\"foreach\" body line %d)",
+			interp->errorLine);
+		Tcl_AddObjErrorInfo(interp, msg, -1);
+		break;
+	    } else {
+		break;
+	    }
+	}
+    }
+    if (result == TCL_OK) {
+	Tcl_ResetResult(interp);
+    }
 
-    result = TCL_OK;
-  done:
-    ForeachCleanup(interp, statePtr);
+    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);
+    }
     return result;
+#undef STATIC_LIST_SIZE
+#undef NUM_ARGS
 }
-
+
 /*
- * Post-body processing handler.
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FormatObjCmd --
+ *
+ *	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.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
  */
 
-static int
-ForeachLoopStep(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
+	/* 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. */
 {
-    register struct ForeachState *statePtr = data[0];
+    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. */
 
     /*
-     * Process the result code from this run of the [foreach] body. Note that
-     * this switch uses fallthroughs in several places. Maintainer aware!
+     * 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.
      */
 
-    switch (result) {
-    case TCL_CONTINUE:
-	result = TCL_OK;
-    case TCL_OK:
-	break;
-    case TCL_BREAK:
-	result = TCL_OK;
-	goto done;
-    case TCL_ERROR:
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"foreach\" body line %d)", Tcl_GetErrorLine(interp)));
-    default:
-	goto done;
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg arg ...?");
+	return TCL_ERROR;
     }
 
-    /*
-     * Test if there is work still to be done. If so, do the next round of
-     * variable assignments, reschedule ourselves and run the body again.
-     */
+    format = Tcl_GetStringFromObj(objv[1], &formatLen);
+    endPtr = format + formatLen;
+    resultPtr = Tcl_NewObj();
+    objIndex = 2;
 
-    if (statePtr->maxj > ++statePtr->j) {
-	result = ForeachAssignments(interp, statePtr);
-	if (result == TCL_ERROR) {
-	    goto done;
-	}
+    while (format < endPtr) {
+	register char *newPtr = newFormat;
 
-	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
-	return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
-		((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
-    }
+	width = precision = noPercent = useShort = 0;
+	gotZero = gotMinus = gotPrecision = 0;
+	useWide = 0;
+	whichValue = PTR_VALUE;
 
-    /*
-     * We're done. Tidy up our work space and finish off.
-     */
-
-    Tcl_ResetResult(interp);
-  done:
-    ForeachCleanup(interp, statePtr);
-    return result;
-}
+	/*
+	 * 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;
+	}
 
-/*
- * Factored out code to do the assignments in [foreach].
- */
+	if (format[1] == '%') {
+	    ptrValue = format;
+	    size = 1;
+	    noPercent = 1;
+	    format += 2;
+	    goto doField;
+	}
 
-static inline int
-ForeachAssignments(
-    Tcl_Interp *interp,
-    struct ForeachState *statePtr)
-{
-    int i, v, k;
-    Tcl_Obj *valuePtr, *varValuePtr;
+	/*
+	 * 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;
 
-    for (i=0 ; i<statePtr->numLists ; i++) {
-	for (v=0 ; v<statePtr->varcList[i] ; v++) {
-	    k = statePtr->index[i]++;
+	    /*
+	     * 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.
+	     */
 
-	    if (k < statePtr->argcList[i]) {
-		valuePtr = statePtr->argvList[i][k];
-	    } else {
-		TclNewObj(valuePtr);	/* Empty 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;
+	}
 
-	    varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v],
-		    NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+	notXpg:
+	gotSequential = 1;
+	if (gotXpg) {
+	    goto mixedXPG;
+	}
 
-	    if (varValuePtr == NULL) {
-		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (setting foreach loop variable \"%s\")",
-			TclGetString(statePtr->varvList[i][v])));
-		return TCL_ERROR;
+	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.
+	     */
 
-    return TCL_OK;
-}
+	    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);
+	    }
 
-/*
- * Factored out code for cleaning up the state of the foreach.
- */
+#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.
+	     */
 
-static inline void
-ForeachCleanup(
-    Tcl_Interp *interp,
-    struct ForeachState *statePtr)
-{
-    int i;
+	    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++;
 
-    for (i=0 ; i<statePtr->numLists ; i++) {
-	if (statePtr->vCopyList[i]) {
-	    TclDecrRefCount(statePtr->vCopyList[i]);
+	/*
+	 * Make sure that there's enough space to hold the formatted
+	 * result, then format it.
+	 */
+
+	doField:
+	if (width > size) {
+	    size = width;
 	}
-	if (statePtr->aCopyList[i]) {
-	    TclDecrRefCount(statePtr->aCopyList[i]);
+	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);
 	}
     }
-    TclStackFree(interp, statePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FormatObjCmd --
- *
- *	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.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
 
-	/* ARGSUSED */
-int
-Tcl_FormatObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *resultPtr;		/* Where result is stored finally. */
+    Tcl_SetObjResult(interp, resultPtr);
+    if (dst != staticBuf) {
+	ckfree(dst);
+    }
+    return TCL_OK;
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
-	return TCL_ERROR;
+    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);
     }
 
-    resultPtr = Tcl_Format(interp, TclGetString(objv[1]), objc-2, objv+2);
-    if (resultPtr == NULL) {
-	return TCL_ERROR;
+    fmtError:
+    if (dst != staticBuf) {
+	ckfree(dst);
     }
-    Tcl_SetObjResult(interp, resultPtr);
-    return TCL_OK;
+    Tcl_DecrRefCount(resultPtr);
+    return TCL_ERROR;
 }
 
 /*
@@ -2823,3 +2457,4 @@ Tcl_FormatObjCmd(
  * fill-column: 78
  * End:
  */
+
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index b312026..21dbdc8 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1,83 +1,62 @@
-/*
+/* 
  * 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) 2005 Donal K. Fellows.
+ * 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 "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 {
-    union {                     /* The value that we sorting by. */
-	const char *strValuePtr;
-	long intValue;
-	double doubleValue;
-	Tcl_Obj *objValuePtr;
-    } collationKey;
-    union {             	/* Object being sorted, or its index. */
-        Tcl_Obj *objPtr;
-        int index;
-    } payload;
-    struct SortElement *nextPtr;/* Next element in the list, or NULL for end
-				 * of list. */
+    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. */
 } SortElement;
 
 /*
- * 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.
+ * 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 *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. */
+    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. */
 } SortInfo;
 
 /*
@@ -85,120 +64,115 @@ 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_NC	8
+#define SORTMODE_ASCII      0
+#define SORTMODE_INTEGER    1
+#define SORTMODE_REAL       2
+#define SORTMODE_COMMAND    3
+#define SORTMODE_DICTIONARY 4
 
 /*
- * 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 int		DictionaryCompare(const char *left, const char *right);
-static int		IfConditionCallback(ClientData data[],
-			    Tcl_Interp *interp, int result);
-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 #348 - New 'info' subcommand 'errorstack' */
-static int		InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
+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
 /* TIP #280 - New 'info' subcommand 'frame' */
-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,
+static int		InfoFrameCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    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, NULL, NULL, 0},
-    {"body",		   InfoBodyCmd,		    NULL, NULL, NULL, 0},
-    {"cmdcount",	   InfoCmdCountCmd,	    NULL, NULL, NULL, 0},
-    {"commands",	   InfoCommandsCmd,	    NULL, NULL, NULL, 0},
-    {"complete",	   InfoCompleteCmd,	    NULL, NULL, NULL, 0},
-    {"coroutine",	   TclInfoCoroutineCmd,     NULL, NULL, NULL, 0},
-    {"default",		   InfoDefaultCmd,	    NULL, NULL, NULL, 0},
-    {"errorstack",	   InfoErrorStackCmd,	    NULL, NULL, NULL, 0},
-    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
-    {"frame",		   InfoFrameCmd,	    NULL, NULL, NULL, 0},
-    {"functions",	   InfoFunctionsCmd,	    NULL, NULL, NULL, 0},
-    {"globals",		   TclInfoGlobalsCmd,	    NULL, NULL, NULL, 0},
-    {"hostname",	   InfoHostnameCmd,	    NULL, NULL, NULL, 0},
-    {"level",		   InfoLevelCmd,	    NULL, NULL, NULL, 0},
-    {"library",		   InfoLibraryCmd,	    NULL, NULL, NULL, 0},
-    {"loaded",		   InfoLoadedCmd,	    NULL, NULL, NULL, 0},
-    {"locals",		   TclInfoLocalsCmd,	    NULL, NULL, NULL, 0},
-    {"nameofexecutable",   InfoNameOfExecutableCmd, NULL, NULL, NULL, 0},
-    {"patchlevel",	   InfoPatchLevelCmd,	    NULL, NULL, NULL, 0},
-    {"procs",		   InfoProcsCmd,	    NULL, NULL, NULL, 0},
-    {"script",		   InfoScriptCmd,	    NULL, NULL, NULL, 0},
-    {"sharedlibextension", InfoSharedlibCmd,	    NULL, NULL, NULL, 0},
-    {"tclversion",	   InfoTclVersionCmd,	    NULL, NULL, NULL, 0},
-    {"vars",		   TclInfoVarsCmd,	    NULL, NULL, NULL, 0},
-    {NULL, NULL, NULL, NULL, NULL, 0}
-};
+			    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,
+			    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_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.
@@ -209,74 +183,51 @@ static const EnsembleImplMap defaultInfoMap[] = {
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_IfObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRIfObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Obj *boolObj;
-
-    if (objc <= 1) {
-	Tcl_AppendResult(interp, "wrong # args: no expression after \"",
-		TclGetString(objv[0]), "\" argument", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * At this point, objv[1] refers to the main expression to test. The
-     * arguments after the expression must be "then" (optional) and a script
-     * to execute if the expression is true.
-     */
-
-    TclNewObj(boolObj);
-    Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc),
-	    (ClientData) objv, INT2PTR(1), boolObj);
-    return Tcl_NRExprObj(interp, objv[1], boolObj);
-}
-
-static int
-IfConditionCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
-    int objc = PTR2INT(data[0]);
-    Tcl_Obj *const *objv = data[1];
-    int i = PTR2INT(data[2]);
-    Tcl_Obj *boolObj = data[3];
-    int value, thenScriptIndex = 0;
-    const char *clause;
-
-    if (result != TCL_OK) {
-	TclDecrRefCount(boolObj);
-	return result;
-    }
-    if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
-	TclDecrRefCount(boolObj);
-	return TCL_ERROR;
-    }
-    TclDecrRefCount(boolObj);
-
+    int thenScriptIndex = 0;	/* then script to be evaled after syntax check */
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
+    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.
+	 */
+
+	if (i >= objc) {
+	    clause = Tcl_GetString(objv[i-1]);
+	    Tcl_AppendResult(interp, "wrong # args: no expression after \"",
+		    clause, "\" argument", (char *) NULL);
+	    return TCL_ERROR;
+	}
+	if (!thenScriptIndex) {
+	    result = Tcl_ExprBooleanObj(interp, objv[i], &value);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
 	i++;
 	if (i >= objc) {
-	    goto missingScript;
+	    missingScript:
+	    clause = Tcl_GetString(objv[i-1]);
+	    Tcl_AppendResult(interp, "wrong # args: no script following \"",
+		    clause, "\" argument", (char *) NULL);
+	    return TCL_ERROR;
 	}
-	clause = TclGetString(objv[i]);
+	clause = Tcl_GetString(objv[i]);
 	if ((i < objc) && (strcmp(clause, "then") == 0)) {
 	    i++;
 	}
@@ -287,85 +238,68 @@ IfConditionCallback(
 	    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) {
-		/*
-		 * TIP #280. Make invoking context available to branch.
-		 */
-
-		return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
-			iPtr->cmdFramePtr, thenScriptIndex);
+#ifndef TCL_TIP280
+		return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+#else
+		/* TIP #280. Make invoking context available to branch */
+		return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
+				    iPtr->cmdFramePtr,thenScriptIndex);
+#endif
 	    }
 	    return TCL_OK;
 	}
-	clause = TclGetString(objv[i]);
-	if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) {
-	    break;
-	}
-	i++;
-
-	/*
-	 * 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) {
-	    Tcl_AppendResult(interp, "wrong # args: ",
-		    "no expression after \"", clause, "\" argument", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-	    return TCL_ERROR;
-	}
-	if (!thenScriptIndex) {
-	    TclNewObj(boolObj);
-	    Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
-		    INT2PTR(i), boolObj);
-	    return Tcl_NRExprObj(interp, objv[i], boolObj);
+	clause = Tcl_GetString(objv[i]);
+	if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
+	    i++;
+	    continue;
 	}
+	break;
     }
 
     /*
-     * 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) {
-	    goto missingScript;
+	    Tcl_AppendResult(interp,
+		    "wrong # args: no script following \"else\" argument",
+		    (char *) NULL);
+	    return TCL_ERROR;
 	}
     }
     if (i < objc - 1) {
-	Tcl_AppendResult(interp, "wrong # args: ",
-		"extra words after \"else\" clause in \"if\" command", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
+	Tcl_AppendResult(interp,
+		"wrong # args: extra words after \"else\" clause in \"if\" command",
+		(char *) NULL);
 	return TCL_ERROR;
     }
     if (thenScriptIndex) {
-	/*
-	 * TIP #280. Make invoking context available to branch/else.
-	 */
-
-	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
-		iPtr->cmdFramePtr, thenScriptIndex);
+#ifndef TCL_TIP280
+	return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);
+#else
+	/* TIP #280. Make invoking context available to branch/else */
+	return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
+			    iPtr->cmdFramePtr,thenScriptIndex);
+#endif
     }
-    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
-
-  missingScript:
-    clause = TclGetString(objv[i-1]);
-    Tcl_AppendResult(interp, "wrong # args: no script following \"", clause,
-	    "\" argument", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-    return TCL_ERROR;
+#ifndef TCL_TIP280
+    return Tcl_EvalObjEx(interp, objv[i], 0);
+#else
+    return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr,i);
+#endif
 }
 
 /*
@@ -373,12 +307,12 @@ IfConditionCallback(
  *
  * 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.
@@ -389,30 +323,64 @@ IfConditionCallback(
  *----------------------------------------------------------------------
  */
 
+    /* ARGSUSED */
 int
-Tcl_IncrObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *newValuePtr, *incrPtr;
-
+    long incrAmount;
+    Tcl_Obj *newValuePtr;
+    
     if ((objc != 2) && (objc != 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
+        Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
 	return TCL_ERROR;
     }
 
-    if (objc == 3) {
-	incrPtr = objv[2];
+    /*
+     * Calculate the amount to increment by.
+     */
+    
+    if (objc == 2) {
+	incrAmount = 1;
     } else {
-	incrPtr = Tcl_NewIntObj(1);
+	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;
+	    }
+	}
     }
-    Tcl_IncrRefCount(incrPtr);
-    newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
-	    incrPtr, TCL_LEAVE_ERR_MSG);
-    Tcl_DecrRefCount(incrPtr);
+    
+    /*
+     * Increment the variable's value.
+     */
 
+    newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, incrAmount,
+	    TCL_LEAVE_ERR_MSG);
     if (newValuePtr == NULL) {
 	return TCL_ERROR;
     }
@@ -423,31 +391,141 @@ Tcl_IncrObjCmd(
      */
 
     Tcl_SetObjResult(interp, newValuePtr);
-    return TCL_OK;
+    return TCL_OK; 
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclInitInfoCmd --
+ * Tcl_InfoObjCmd --
  *
- *	This function is called to create the "info" Tcl command. See the user
- *	documentation for details on what it does.
+ *	This procedure is invoked to process the "info" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
- *	Handle for the info command, or NULL on failure.
+ *	A standard Tcl result.
  *
  * Side effects:
- *	none
+ *	See the user documentation.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Command
-TclInitInfoCmd(
-    Tcl_Interp *interp)		/* Current interpreter. */
+	/* 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. */
 {
-    return TclMakeEnsemble(interp, "info", defaultInfoMap);
+    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;
 }
 
 /*
@@ -455,58 +533,58 @@ TclInitInfoCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     register Interp *iPtr = (Interp *) interp;
-    const char *name;
+    char *name;
     Proc *procPtr;
     CompiledLocal *localPtr;
     Tcl_Obj *listObjPtr;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "procname");
-	return TCL_ERROR;
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "procname");
+        return TCL_ERROR;
     }
 
-    name = TclGetString(objv[1]);
+    name = Tcl_GetString(objv[2]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "\"", name, "\" isn't a procedure", (char *) NULL);
+        return TCL_ERROR;
     }
 
     /*
      * Build a return list containing the arguments.
      */
-
-    listObjPtr = Tcl_NewListObj(0, NULL);
+    
+    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) 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;
@@ -517,66 +595,65 @@ InfoArgsCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     register Interp *iPtr = (Interp *) interp;
-    const char *name;
+    char *name;
     Proc *procPtr;
     Tcl_Obj *bodyPtr, *resultPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "procname");
-	return TCL_ERROR;
+    
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "procname");
+        return TCL_ERROR;
     }
 
-    name = TclGetString(objv[1]);
+    name = Tcl_GetString(objv[2]);
     procPtr = TclFindProc(iPtr, name);
     if (procPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"\"", name, "\" isn't a procedure", (char *) 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]
 	 */
-
-	TclGetString(bodyPtr);
+	(void) Tcl_GetString(bodyPtr);
     }
     resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-
+    
     Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
@@ -586,37 +663,37 @@ InfoBodyCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
     }
 
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount));
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->cmdCount);
     return TCL_OK;
 }
 
@@ -625,74 +702,74 @@ InfoCmdCountCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *cmdName, *pattern;
-    const char *simplePattern;
+    char *cmdName, *pattern;
+    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 == 1) {
-	simplePattern = NULL;
+    if (objc == 2) {
+        simplePattern = NULL;
 	nsPtr = currNsPtr;
 	specificNsInPattern = 0;
-    } else if (objc == 2) {
+    } 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 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 = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr,
-		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+	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. */
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
     } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
     }
 
     /*
@@ -704,24 +781,24 @@ InfoCommandsCmd(
     }
 
     /*
-     * 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, NULL);
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) 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) {
-		cmd = Tcl_GetHashValue(entryPtr);
+		cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
 		elemObjPtr = Tcl_NewObj();
 		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
 	    } else {
@@ -729,50 +806,23 @@ InfoCommandsCmd(
 		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
 	    }
 	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
-	    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);
-	    }
+	} else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
+	    entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable,
+		    simplePattern);
 	    if (entryPtr != NULL) {
-		cmdName = Tcl_GetHashKey(tablePtr, entryPtr);
+		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
 		Tcl_ListObjAppendElement(interp, listPtr,
 			Tcl_NewStringObj(cmdName, -1));
-		Tcl_SetObjResult(interp, listPtr);
-		return TCL_OK;
 	    }
 	}
-    } 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.
-	 */
-
+    } else {
 	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_GetHashValue(entryPtr);
+		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
 		    elemObjPtr = Tcl_NewObj();
 		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
 		} else {
@@ -785,19 +835,19 @@ InfoCommandsCmd(
 
 	/*
 	 * 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));
 		    }
@@ -805,97 +855,8 @@ InfoCommandsCmd(
 		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,
-			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,
-			    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;
 }
@@ -905,36 +866,40 @@ InfoCommandsCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "command");
-	return TCL_ERROR;
+    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);
     }
 
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-	    TclObjCommandComplete(objv[1])));
     return TCL_OK;
 }
 
@@ -943,559 +908,513 @@ InfoCompleteCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
-    const char *procName, *argName;
+    char *procName, *argName, *varName;
     Proc *procPtr;
     CompiledLocal *localPtr;
     Tcl_Obj *valueObjPtr;
 
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname");
-	return TCL_ERROR;
+    if (objc != 5) {
+        Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");
+        return TCL_ERROR;
     }
 
-    procName = TclGetString(objv[1]);
-    argName = TclGetString(objv[2]);
+    procName = Tcl_GetString(objv[2]);
+    argName = Tcl_GetString(objv[3]);
 
     procPtr = TclFindProc(iPtr, procName);
     if (procPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
-		NULL);
-	return TCL_ERROR;
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"\"", procName, "\" isn't a procedure", (char *) 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[3], NULL,
-			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
-		if (valueObjPtr == NULL) {
-		    return TCL_ERROR;
-		}
-		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
-	    } else {
-		Tcl_Obj *nullObjPtr = Tcl_NewObj();
-
-		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
-			nullObjPtr, TCL_LEAVE_ERR_MSG);
-		if (valueObjPtr == NULL) {
-		    return TCL_ERROR;
-		}
-		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
-	    }
-	    return TCL_OK;
-	}
+            if (localPtr->defValuePtr != NULL) {
+		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], 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,
+			nullObjPtr, 0);
+		Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */
+                if (valueObjPtr == NULL) {
+                    goto defStoreError;
+                }
+		Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+            }
+            return TCL_OK;
+        }
     }
 
-    Tcl_AppendResult(interp, "procedure \"", procName,
-	    "\" doesn't have an argument \"", argName, "\"", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
+    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	    "procedure \"", procName, "\" doesn't have an argument \"",
+	    argName, "\"", (char *) NULL);
     return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * InfoErrorStackCmd --
+ * InfoExistsCmd --
  *
- *	Called to implement the "info errorstack" command that returns information
- *	about the last error's call stack. Handles the following syntax:
+ *      Called to implement the "info exists" command that determines
+ *      whether a variable exists. Handles the following syntax:
  *
- *	    info errorstack ?interp?
+ *          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
-InfoErrorStackCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Interp *target;
-    Interp *iPtr;
-
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
-	return TCL_ERROR;
-    }
-
-    target = interp;
-    if (objc == 2) {
-        target = Tcl_GetSlave(interp, Tcl_GetString(objv[1]));
-        if (target == NULL) {
-            return TCL_ERROR;
-        }
-    }
-
-    iPtr = (Interp *) target;
-    Tcl_SetObjResult(interp, iPtr->errorStack);
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInfoExistsCmd --
- *
- *	Called to implement the "info exists" command that determines whether
- *	a variable exists. Handles the following syntax:
- *
- *	    info exists varName
- *
- * 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
-TclInfoExistsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *varName;
+    char *varName;
     Var *varPtr;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName");
-	return TCL_ERROR;
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "varName");
+        return TCL_ERROR;
     }
 
-    varName = TclGetString(objv[1]);
+    varName = Tcl_GetString(objv[2]);
     varPtr = TclVarTraceExists(interp, varName);
-
-    Tcl_SetObjResult(interp,
-	    Tcl_NewBooleanObj(varPtr && varPtr->value.objPtr));
+    if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
+        Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+    } else {
+        Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+    }
     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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
-    int level, topLevel, code = TCL_OK;
-    CmdFrame *runPtr, *framePtr;
-    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
 
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
-	return TCL_ERROR;
-    }
+    if (objc == 2) {
+	/* just "info frame" */
+        int levels = (iPtr->cmdFramePtr == NULL
+		      ? 0
+		      : iPtr->cmdFramePtr->level);
 
-    topLevel = ((iPtr->cmdFramePtr == NULL)
-	    ? 0
-	    : iPtr->cmdFramePtr->level);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj (levels));
+        return TCL_OK;
 
-    if (corPtr) {
-	/*
-	 * A coroutine: must fix the level computations AND the cmdFrame chain,
-	 * which is interrupted at the base.
-	 */
-	CmdFrame *lastPtr = NULL;
+    } else if (objc == 3) {
+	/* "info frame level" */
+        int       level;
+	CmdFrame *framePtr;
 
-        runPtr = iPtr->cmdFramePtr;
+        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) {
 
-	/* TODO - deal with overflow */
-        topLevel += corPtr->caller.cmdFramePtr->level;
-	while (runPtr) {
-	    runPtr->level += corPtr->caller.cmdFramePtr->level;
-	    lastPtr = runPtr;
-	    runPtr = runPtr->nextPtr;
-	}
-	if (lastPtr) {
-	    lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
-	} else {
-	    iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
-	}
-    }
+	    if (framePtr->level == level) {
+                break;
+            }
+        }
+        if (framePtr == NULL) {
+            goto levelError;
+        }
 
-    if (objc == 1) {
 	/*
-	 * Just "info frame".
+	 * Pull the information and construct the dictionary to return, as
+	 * list. Regarding use of the CmdFrame fields see tclInt.h, and its
+	 * definition.
 	 */
 
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
-	goto done;
-    }
-
-    /*
-     * We've got "info frame level" and must parse the level first.
-     */
-
-    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
-	code = TCL_ERROR;
-	goto done;
-    }
+	{
+	    Tcl_Obj* lv [20]; /* Keep uptodate when more keys are added to the dict */
+	    int      lc = 0;
 
-    if ((level > topLevel) || (level <= - topLevel)) {
-    levelError:
-	Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME",
-		TclGetString(objv[1]), NULL);
-	code = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Let us convert to relative so that we know how many levels to go back
-     */
-
-    if (level > 0) {
-	level -= topLevel;
-    }
-
-    framePtr = iPtr->cmdFramePtr;
-    while (++level <= 0) {
-	framePtr = framePtr->nextPtr;
-	if (!framePtr) {
-	    goto levelError;
-	}
-    }
-
-    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
-
-  done:
-    if (corPtr) {
-
-	if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
-	    iPtr->cmdFramePtr = NULL;
-	} else {
-	    runPtr = iPtr->cmdFramePtr;
-	    while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
-	    	runPtr->level -= corPtr->caller.cmdFramePtr->level;
-		runPtr = runPtr->nextPtr;
-	    }
-	    runPtr->level = 1;
-	    runPtr->nextPtr = NULL;
-	}
-
-    }
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInfoFrame --
- *
- *	Core of InfoFrameCmd, returns TIP280 dict for a given frame.
- *
- * Results:
- *	Returns TIP280 dict.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+	    /* This array is indexed by the TCL_LOCATION_... values, except
+	     * for _LAST.
+	     */
 
-Tcl_Obj *
-TclInfoFrame(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    CmdFrame *framePtr)		/* Frame to get info for. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *tmpObj;
-    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 *const typeString[TCL_LOCATION_LAST] = {
-	"eval", "eval", "eval", "precompiled", "source", "proc"
-    };
-    Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
+	    static CONST char* typeString [TCL_LOCATION_LAST] = {
+	       "eval", "eval", "eval", "precompiled", "source", "proc"
+	    };
 
-    /*
-     * Pull the information and construct the dictionary to return, as list.
-     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
-     */
+	    Proc*    procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
 
-#define ADD_PAIR(name, value) \
-	TclNewLiteralStringObj(tmpObj, name); \
-	lv[lc++] = tmpObj; \
-	lv[lc++] = (value)
+	    switch (framePtr->type) {
+	    case TCL_LOCATION_EVAL:
+	        /* Evaluation, dynamic script. Type, line, cmd, the latter
+		 * through str. */
 
-    switch (framePtr->type) {
-    case TCL_LOCATION_EVAL:
-	/*
-	 * Evaluation, dynamic script. Type, line, cmd, the latter through
-	 * str.
-	 */
+	        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;
 
-	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_EVAL_LIST:
+	        /* List optimized evaluation. Type, line, cmd, the latter
+		 * through listPtr, possibly a frame. */
 
-    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);
+		lv [lc ++] = Tcl_NewStringObj ("line",-1);
+		lv [lc ++] = Tcl_NewIntObj    (1);
 
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	ADD_PAIR("line", Tcl_NewIntObj(1));
+		/* 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.
+		 */
 
-	/*
-	 * 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.
-	 */
+		lv [lc ++] =  Tcl_NewStringObj ("cmd",-1);
+		lv [lc ++] =  Tcl_DuplicateObj (framePtr->cmd.listPtr);
+		break;
 
-	ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
-	break;
+	    case TCL_LOCATION_PREBC:
+	        /* Precompiled. Result contains the type as signal, nothing
+		 * else */
 
-    case TCL_LOCATION_PREBC:
-	/*
-	 * Precompiled. Result contains the type as signal, nothing else.
-	 */
+	        lv [lc ++] = Tcl_NewStringObj ("type",-1);
+		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);
+		break;
 
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	break;
+	    case TCL_LOCATION_BC: {
+	        /* Execution of bytecode. Talk to the BC engine to fill out
+		 * the frame. */
 
-    case TCL_LOCATION_BC: {
-	/*
-	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
-	 */
+	        CmdFrame f = *framePtr;
 
-	CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+		/* Note: Type BC => f.data.eval.path    is not used.
+		 *                  f.data.tebc.codePtr is used instead.
+		 */
 
-	*fPtr = *framePtr;
+	        TclGetSrcInfoForPc (&f);
+		/* Now filled:        cmd.str.(cmd,len), line */
+		/* Possibly modified: type, path! */
 
-	/*
-	 * Note:
-	 * Type BC => f.data.eval.path	  is not used.
-	 *	      f.data.tebc.codePtr is used instead.
-	 */
+	        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]);
 
-	TclGetSrcInfoForPc(fPtr);
+		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);
+		}
 
-	/*
-	 * Now filled: cmd.str.(cmd,len), line
-	 * Possibly modified: type, path!
-	 */
+		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);
+		lv [lc ++] = Tcl_NewStringObj (f.cmd.str.cmd, f.cmd.str.len);
+	        break;
+	    }
 
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
-	if (fPtr->line) {
-	    ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
-	}
+	    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;
 
-	if (fPtr->type == TCL_LOCATION_SOURCE) {
-	    ADD_PAIR("file", fPtr->data.eval.path);
+	    case TCL_LOCATION_PROC:
+		Tcl_Panic ("TCL_LOCATION_PROC found in standard frame");
+		break;
+	    }
 
 	    /*
-	     * Death of reference by TclGetSrcInfoForPc.
+	     * 'proc'. Common to all frame types. Conditional on having an
+	     * associated Procedure CallFrame.
 	     */
 
-	    Tcl_DecrRefCount(fPtr->data.eval.path);
-	}
-
-	ADD_PAIR("cmd",
-		Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
-	TclStackFree(interp, fPtr);
-	break;
-    }
-
-    case TCL_LOCATION_SOURCE:
-	/*
-	 * Evaluation of a script file.
-	 */
-
-	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
-	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
-	ADD_PAIR("file", framePtr->data.eval.path);
-
-	/*
-	 * Refcount framePtr->data.eval.path goes up when lv is converted into
-	 * the result list object.
-	 */
-
-	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
-		framePtr->cmd.str.len));
-	break;
+	    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;
 
-    case TCL_LOCATION_PROC:
-	Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
-	break;
-    }
+		    lv [lc ++] = Tcl_NewStringObj ("proc",-1);
+		    lv [lc ++] = Tcl_NewStringObj (nsName,-1);
 
-    /*
-     * 'proc'. Common to all frame types. Conditional on having an associated
-     * Procedure CallFrame.
-     */
+		    if (strcmp (nsName, "::") != 0) {
+			Tcl_AppendToObj (lv [lc-1], "::", -1);
+		    }
+		    Tcl_AppendToObj (lv [lc-1], procName, -1);
+		}
+	    }
 
-    if (procPtr != NULL) {
-	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;
+	    /* 'level'. Common to all frame types. Conditional on having an
+	     * associated _visible_ CallFrame */
 
-	if (namePtr) {
-            Tcl_Obj *procNameObj;
+	    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
+	        CallFrame* current = framePtr->framePtr;
+		CallFrame* top     = iPtr->varFramePtr;
+		CallFrame* idx;
 
-	    /*
-	     * This is a regular command.
-	     */
+		for (idx = top;
+		     idx != NULL;
+		     idx = idx->callerVarPtr) {
+		    if (idx == current) {
+		        int c = framePtr->framePtr->level;
+			int t = iPtr->varFramePtr->level;
 
-            TclNewObj(procNameObj);
-            Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
-                    procNameObj);
-	    ADD_PAIR("proc", procNameObj);
-	} else if (procPtr->cmdPtr->clientData) {
-	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
-	    int i;
-
-	    /*
-	     * 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;
+			lv [lc ++] = Tcl_NewStringObj ("level",-1);
+			lv [lc ++] = Tcl_NewIntObj (t - c);
+			break;
+		    }
 		}
 	    }
+
+	    Tcl_SetObjResult(interp, Tcl_NewListObj (lc, lv));
+	    return TCL_OK;
 	}
     }
 
-    /*
-     * 'level'. Common to all frame types. Conditional on having an associated
-     * _visible_ CallFrame.
-     */
+    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
 
-    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
-	CallFrame *current = framePtr->framePtr;
-	CallFrame *top = iPtr->varFramePtr;
-	CallFrame *idx;
+    return TCL_ERROR;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InfoFunctionsCmd --
+ *
+ *      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?
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
-	    if (idx == current) {
-		int c = framePtr->framePtr->level;
-		int t = iPtr->varFramePtr->level;
+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. */
+{
+    char *pattern;
+    Tcl_Obj *listPtr;
 
-		ADD_PAIR("level", Tcl_NewIntObj(t - c));
-		break;
-	    }
-	}
+    if (objc == 2) {
+        pattern = NULL;
+    } else if (objc == 3) {
+        pattern = Tcl_GetString(objv[2]);
+    } else {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
     }
 
-    return Tcl_NewListObj(lc, lv);
+    listPtr = Tcl_ListMathFuncs(interp, pattern);
+    if (listPtr == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * InfoFunctionsCmd --
+ * InfoGlobalsCmd --
  *
- *	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 globals" command that returns the list
+ *      of global variables matching an optional pattern. Handles the
+ *      following syntax:
  *
- *	    info functions ?pattern?
+ *          info globals ?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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *pattern;
+    char *varName, *pattern;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    register Tcl_HashEntry *entryPtr;
+    Tcl_HashSearch search;
+    Var *varPtr;
+    Tcl_Obj *listPtr;
 
-    if (objc == 1) {
-	pattern = NULL;
-    } else if (objc == 2) {
-	pattern = TclGetString(objv[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, 1, objv, "?pattern?");
-	return TCL_ERROR;
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
     }
 
-    Tcl_SetObjResult(interp, Tcl_ListMathFuncs(interp, pattern));
+    /*
+     * 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_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
@@ -1504,43 +1423,43 @@ InfoFunctionsCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *name;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    CONST char *name;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
     }
 
     name = Tcl_GetHostName();
     if (name) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
+	Tcl_SetStringObj(Tcl_GetObjResult(interp), 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);
-    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
-    return TCL_ERROR;
 }
 
 /*
@@ -1548,71 +1467,71 @@ InfoHostnameCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
+    int level;
+    CallFrame *framePtr;
+    Tcl_Obj *listPtr;
 
-    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;
-	}
+    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;
+        }
 
-	Tcl_SetObjResult(interp,
-		Tcl_NewListObj(framePtr->objc, framePtr->objv));
-	return TCL_OK;
+        listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);
+        Tcl_SetObjResult(interp, listPtr);
+        return TCL_OK;
     }
 
-    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
-    return TCL_ERROR;
-
-  levelError:
-    Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
-	    NULL);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
-	    TclGetString(objv[1]), NULL);
+    Tcl_WrongNumArgs(interp, 2, objv, "?number?");
     return TCL_ERROR;
 }
 
@@ -1621,43 +1540,43 @@ InfoLevelCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *libDirName;
+    CONST char *libDirName;
 
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
     }
 
     libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
     if (libDirName != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
-	return TCL_OK;
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), libDirName, -1);
+        return TCL_OK;
     }
-    Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), 
+            "no library has been specified for Tcl", -1);
     return TCL_ERROR;
 }
 
@@ -1666,42 +1585,174 @@ InfoLibraryCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *interpName;
+    char *interpName;
+    int result;
 
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
-	return TCL_ERROR;
+    if ((objc != 2) && (objc != 3)) {
+        Tcl_WrongNumArgs(interp, 2, objv, "?interp?");
+        return TCL_ERROR;
     }
 
-    if (objc == 1) {		/* Get loaded pkgs in all interpreters. */
+    if (objc == 2) {		/* get loaded pkgs in all interpreters */
 	interpName = NULL;
-    } else {			/* Get pkgs just in specified interp. */
-	interpName = TclGetString(objv[1]);
+    } 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));
+		}
+	    }
+	}
     }
-    return TclGetLoadedPackages(interp, interpName);
 }
 
 /*
@@ -1709,34 +1760,41 @@ InfoLoadedCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    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);
     }
-    Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
     return TCL_OK;
 }
 
@@ -1745,41 +1803,41 @@ InfoNameOfExecutableCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *patchlevel;
+    CONST char *patchlevel;
 
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, 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_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1));
-	return TCL_OK;
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), patchlevel, -1);
+        return TCL_OK;
     }
     return TCL_ERROR;
 }
@@ -1789,75 +1847,76 @@ InfoPatchLevelCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *cmdName, *pattern;
-    const char *simplePattern;
+    char *cmdName, *pattern;
+    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 == 1) {
+    if (objc == 2) {
 	simplePattern = NULL;
 	nsPtr = currNsPtr;
 	specificNsInPattern = 0;
-    } else if (objc == 2) {
+    } 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 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 = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr,
-		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+	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. */
+	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */
 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
 	}
     } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
+        return TCL_ERROR;
     }
 
     if (nsPtr == NULL) {
@@ -1865,18 +1924,18 @@ InfoProcsCmd(
     }
 
     /*
-     * 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, NULL);
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
 #ifndef INFO_PROCS_SEARCH_GLOBAL_NS
     if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
 	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
 	if (entryPtr != NULL) {
-	    cmdPtr = Tcl_GetHashValue(entryPtr);
+	    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
 
 	    if (!TclIsProc(cmdPtr)) {
 		realCmdPtr = (Command *)
@@ -1885,7 +1944,7 @@ InfoProcsCmd(
 		    goto simpleProcOK;
 		}
 	    } else {
-	    simpleProcOK:
+	      simpleProcOK:
 		if (specificNsInPattern) {
 		    elemObjPtr = Tcl_NewObj();
 		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1903,8 +1962,8 @@ InfoProcsCmd(
 	while (entryPtr != NULL) {
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
 	    if ((simplePattern == NULL)
-		    || Tcl_StringMatch(cmdName, simplePattern)) {
-		cmdPtr = Tcl_GetHashValue(entryPtr);
+	            || Tcl_StringMatch(cmdName, simplePattern)) {
+		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
 
 		if (!TclIsProc(cmdPtr)) {
 		    realCmdPtr = (Command *)
@@ -1913,7 +1972,7 @@ InfoProcsCmd(
 			goto procOK;
 		    }
 		} else {
-		procOK:
+		  procOK:
 		    if (specificNsInPattern) {
 			elemObjPtr = Tcl_NewObj();
 			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1929,36 +1988,35 @@ InfoProcsCmd(
 
 	/*
 	 * 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) {
-			cmdPtr = Tcl_GetHashValue(entryPtr);
+	                || 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));
 			}
 		    }
 		}
@@ -1977,46 +2035,47 @@ InfoProcsCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?filename?");
-	return TCL_ERROR;
+    if ((objc != 2) && (objc != 3)) {
+        Tcl_WrongNumArgs(interp, 2, objv, "?filename?");
+        return TCL_ERROR;
     }
 
-    if (objc == 2) {
+    if (objc == 3) {
 	if (iPtr->scriptFile != NULL) {
 	    Tcl_DecrRefCount(iPtr->scriptFile);
 	}
-	iPtr->scriptFile = objv[1];
+	iPtr->scriptFile = objv[2];
 	Tcl_IncrRefCount(iPtr->scriptFile);
     }
     if (iPtr->scriptFile != NULL) {
-	Tcl_SetObjResult(interp, iPtr->scriptFile);
+        Tcl_SetObjResult(interp, iPtr->scriptFile);
     }
     return TCL_OK;
 }
@@ -2026,36 +2085,36 @@ InfoScriptCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
     }
-
+    
 #ifdef TCL_SHLIB_EXT
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1));
+    Tcl_SetStringObj(Tcl_GetObjResult(interp), TCL_SHLIB_EXT, -1);
 #endif
     return TCL_OK;
 }
@@ -2065,40 +2124,40 @@ InfoSharedlibCmd(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    Tcl_Obj *version;
+    CONST char *version;
 
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        return TCL_ERROR;
     }
 
-    version = Tcl_GetVar2Ex(interp, "tcl_version", NULL,
-	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+    version = Tcl_GetVar(interp, "tcl_version",
+        (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
     if (version != NULL) {
-	Tcl_SetObjResult(interp, version);
-	return TCL_OK;
+        Tcl_SetStringObj(Tcl_GetObjResult(interp), version, -1);
+        return TCL_OK;
     }
     return TCL_ERROR;
 }
@@ -2106,10 +2165,204 @@ InfoTclVersionCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * 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:
+ *
+ *          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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    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.
+	 */
+
+	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 the namespace specified in the pattern wasn't found, just return.
+     */
+
+    if (nsPtr == NULL) {
+	return TCL_OK;
+    }
+    
+    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.
+	     */
+
+	    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);
+		}
+	    }
+	}
+    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
+	AppendLocals(interp, listPtr, simplePattern, 1);
+    }
+    
+    Tcl_SetObjResult(interp, listPtr);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_JoinObjCmd --
  *
- *	This procedure is invoked to process the "join" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "join" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl object result.
@@ -2120,52 +2373,62 @@ InfoTclVersionCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_JoinObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    int listLen, i;
-    Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;
+    char *joinString, *bytes;
+    int joinLength, listLen, length, i, result;
+    Tcl_Obj **elemPtrs;
+    Tcl_Obj *resObjPtr;
 
-    if ((objc < 2) || (objc > 3)) {
+    if (objc == 2) {
+	joinString = " ";
+	joinLength = 1;
+    } else if (objc == 3) {
+	joinString = Tcl_GetStringFromObj(objv[2], &joinLength);
+    } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
 	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.
      */
 
-    if (TclListObjGetElements(interp, objv[1], &listLen,
-	    &elemPtrs) != TCL_OK) {
-	return TCL_ERROR;
+    result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
+    if (result != TCL_OK) {
+	return result;
     }
 
-    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
-    Tcl_IncrRefCount(joinObjPtr);
+    /*
+     * Now concatenate strings to form the "joined" result. We append
+     * directly into the interpreter's result object.
+     */
+
+    resObjPtr = Tcl_GetObjResult(interp);
 
-    resObjPtr = Tcl_NewObj();
     for (i = 0;  i < listLen;  i++) {
+	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);
 	if (i > 0) {
-	    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
+	    Tcl_AppendToObj(resObjPtr, joinString, joinLength);
 	}
-	Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
+	Tcl_AppendToObj(resObjPtr, bytes, length);
     }
-    Tcl_DecrRefCount(joinObjPtr);
-    Tcl_SetObjResult(interp, resObjPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LassignObjCmd --
+ * Tcl_LindexObjCmd --
  *
- *	This object-based procedure is invoked to process the "lassign" Tcl
+ *	This object-based procedure is invoked to process the "lindex" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -2177,119 +2440,342 @@ Tcl_JoinObjCmd(
  *----------------------------------------------------------------------
  */
 
+    /* ARGSUSED */
 int
-Tcl_LassignObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *listCopyPtr;
-    Tcl_Obj **listObjv;		/* The contents of the list. */
-    int listObjc;		/* The length of the list. */
-    int code = TCL_OK;
+
+    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted */
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");
 	return TCL_ERROR;
     }
 
-    listCopyPtr = TclListObjCopy(interp, objv[1]);
-    if (listCopyPtr == NULL) {
+    /*
+     * 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 ] );
+
+    } else {
+
+	elemPtr = TclLindexFlat( interp, objv[ 1 ], objc-2, objv+2 );
+
+    }
+	
+    /*
+     * Set the interpreter's object result to the last element extracted
+     */
+
+    if ( elemPtr == NULL ) {
 	return TCL_ERROR;
+    } else {
+	Tcl_SetObjResult(interp, elemPtr);
+	Tcl_DecrRefCount( elemPtr );
+	return TCL_OK;
     }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 */
+{
 
-    TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv);
+    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 */
 
-    objc -= 2;
-    objv += 2;
-    while (code == TCL_OK && objc > 0 && listObjc > 0) {
-	if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
-		TCL_LEAVE_ERR_MSG) == NULL) {
-	    code = TCL_ERROR;
-	}
-	objc--;
-	listObjc--;
+    /*
+     * 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 );
     }
 
-    if (code == TCL_OK && objc > 0) {
-	Tcl_Obj *emptyObj;
+    /*
+     * 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;
 
-	TclNewObj(emptyObj);
-	Tcl_IncrRefCount(emptyObj);
-	while (code == TCL_OK && objc-- > 0) {
-	    if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj,
-		    TCL_LEAVE_ERR_MSG) == NULL) {
-		code = TCL_ERROR;
+	} 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;
 	    }
 	}
-	Tcl_DecrRefCount(emptyObj);
-    }
+	
+	/*
+	 * 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 */
 
-    if (code == TCL_OK && listObjc > 0) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv));
-    }
+    /*
+     * Return the last object extracted.  Its reference count will include
+     * the reference being returned.
+     */
 
-    Tcl_DecrRefCount(listCopyPtr);
-    return code;
+    return listPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_LindexObjCmd --
+ * TclLindexFlat --
  *
- *	This object-based procedure is invoked to process the "lindex" Tcl
- *	command. See the user documentation for details on what it does.
+ *	This procedure handles the 'lindex' command, given that the
+ *	arguments to the command are known to be a flat list.
  *
  * Results:
- *	A standard Tcl object result.
+ *	Returns a standard Tcl result.
  *
  * Side effects:
- *	See the user documentation.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_LindexObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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 */
 {
 
-    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted. */
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
-	return TCL_ERROR;
-    }
+    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. */
 
     /*
-     * 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.
+     * Record the reference to the 'listPtr' object that we are
+     * maintaining in the C activation record.
      */
 
-    if (objc == 3) {
-	elemPtr = TclLindexList(interp, objv[1], objv[2]);
-    } else {
-	elemPtr = TclLindexFlat(interp, objv[1], objc-2, objv+2);
-    }
+    Tcl_IncrRefCount( listPtr );
 
-    /*
-     * Set the interpreter's object result to the last element extracted.
-     */
+    for ( i = 0; i < indexCount; ++i ) {
 
-    if (elemPtr == NULL) {
-	return TCL_ERROR;
+	/*
+	 * 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 );
+	
     }
 
-    Tcl_SetObjResult(interp, elemPtr);
-    Tcl_DecrRefCount(elemPtr);
-    return TCL_OK;
+    return listPtr;
+
 }
 
 /*
@@ -2301,8 +2787,8 @@ Tcl_LindexObjCmd(
  *	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.
@@ -2310,33 +2796,34 @@ Tcl_LindexObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_LinsertObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    register int objc,		/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *listPtr;
-    int index, len, result;
+    int index, isDuplicate, len, result;
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
 	return TCL_ERROR;
     }
 
-    result = TclListObjLength(interp, objv[1], &len);
+    result = Tcl_ListObjLength(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 = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
+    result = TclGetIntForIndex(interp, objv[2], /*end*/ len, &index);
     if (result != TCL_OK) {
 	return result;
     }
@@ -2345,25 +2832,33 @@ Tcl_LinsertObjCmd(
     }
 
     /*
-     * 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 = TclListObjCopy(NULL, listPtr);
+	listPtr = Tcl_DuplicateObj(listPtr);
+	isDuplicate = 1;
     }
 
     if ((objc == 4) && (index == len)) {
 	/*
 	 * Special case: insert one element at the end of the list.
 	 */
-
-	Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
-    } else {
-	Tcl_ListObjReplace(NULL, listPtr, index, 0, (objc-3), &(objv[3]));
+	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;
+    }
+    
     /*
      * Set the interpreter's object result.
      */
@@ -2377,8 +2872,8 @@ Tcl_LinsertObjCmd(
  *
  * 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.
@@ -2389,21 +2884,21 @@ Tcl_LinsertObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-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. */
+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. */
 {
     /*
      * If there are no list elements, the result is an empty object.
-     * Otherwise set the interpreter's result object to be a list object.
+     * Otherwise modify the interpreter's result object to be a list object.
      */
-
+    
     if (objc > 1) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
+	Tcl_SetListObj(Tcl_GetObjResult(interp), (objc-1), &(objv[1]));
     }
     return TCL_OK;
 }
@@ -2414,7 +2909,7 @@ Tcl_ListObjCmd(
  * 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.
@@ -2425,13 +2920,13 @@ Tcl_ListObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_LlengthObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    register Tcl_Obj *const objv[])
-				/* Argument objects. */
+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. */
 {
     int listLen, result;
 
@@ -2440,17 +2935,17 @@ Tcl_LlengthObjCmd(
 	return TCL_ERROR;
     }
 
-    result = TclListObjLength(interp, objv[1], &listLen);
+    result = Tcl_ListObjLength(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_SetObjResult(interp, Tcl_NewIntObj(listLen));
+    Tcl_SetIntObj(Tcl_GetObjResult(interp), listLen);
     return TCL_OK;
 }
 
@@ -2459,8 +2954,8 @@ Tcl_LlengthObjCmd(
  *
  * 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.
@@ -2471,28 +2966,39 @@ Tcl_LlengthObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_LrangeObjCmd(
-    ClientData notUsed,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    register Tcl_Obj *const objv[])
-				/* Argument objects. */
+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_Obj *listPtr;
     Tcl_Obj **elemPtrs;
-    int listLen, first, last, result;
+    int listLen, first, last, numElems, result;
 
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
 	return TCL_ERROR;
     }
 
-    result = TclListObjLength(interp, objv[1], &listLen);
+    /*
+     * 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;
     }
 
-    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
+    /*
+     * Get the first and last indexes.
+     */
+
+    result = TclGetIntForIndex(interp, objv[2], /*endValue*/ (listLen - 1),
 	    &first);
     if (result != TCL_OK) {
 	return result;
@@ -2501,158 +3007,39 @@ Tcl_LrangeObjCmd(
 	first = 0;
     }
 
-    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
+    result = TclGetIntForIndex(interp, objv[3], /*endValue*/ (listLen - 1),
 	    &last);
     if (result != TCL_OK) {
 	return result;
     }
     if (last >= listLen) {
-	last = listLen - 1;
+	last = (listLen - 1);
     }
-
+    
     if (first > last) {
-	/*
-	 * Returning an empty list is easy.
-	 */
-
-	return TCL_OK;
-    }
-
-    result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    if (Tcl_IsShared(objv[1]) ||
-	    ((ListRepPtr(objv[1])->refCount > 1))) {
-	Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
-		&elemPtrs[first]));
-    } else {
-	/*
-	 * In-place is possible.
-	 */
-
-	if (last < (listLen - 1)) {
-	    Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
-		    0, NULL);
-	}
-
-	/*
-	 * This one is not conditioned on (first > 0) in order to preserve the
-	 * string-canonizing effect of [lrange 0 end].
-	 */
-
-	Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
-	Tcl_SetObjResult(interp, objv[1]);
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 = NULL;
-
-    /*
-     * Check arguments for legality:
-     *		lrepeat count ?value ...?
-     */
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
-	return TCL_ERROR;
-    }
-    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
-	return TCL_ERROR;
-    }
-    if (elementCount < 0) {
-	Tcl_SetObjResult(interp, Tcl_Format(NULL,
-		"bad count \"%d\": must be integer >= 0", 1, objv+1));
-        Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPEAT","NEGARG", NULL);
-	return TCL_ERROR;
+	return TCL_OK;		/* the result is an empty object */
     }
 
     /*
-     * Skip forward to the interesting arguments now we've finished parsing.
-     */
-
-    objc -= 2;
-    objv += 2;
-
-    /* Final sanity check. Do not exceed limits on max list length. */
-
-    if (elementCount && objc > LIST_MAX/elementCount) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
-        Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	return TCL_ERROR;
-    }
-    totalElems = objc * elementCount;
-
-    /*
-     * Get an empty list object that is allocated large enough to hold each
-     * init value elementCount times.
-     */
-
-    listPtr = Tcl_NewListObj(totalElems, NULL);
-    if (totalElems) {
-	List *listRepPtr = ListRepPtr(listPtr);
-
-	listRepPtr->elemCount = elementCount*objc;
-	dataArray = &listRepPtr->elements;
+     * Make sure listPtr still refers to a list object. It might have been
+     * converted to an int above if the argument objects were shared.
+     */  
+
+    if (listPtr->typePtr != &tclListType) {
+        result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
+                &elemPtrs);
+        if (result != TCL_OK) {
+            return result;
+        }
     }
 
     /*
-     * 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.
+     * Extract a range of fields. We modify the interpreter's result object
+     * to be a list object containing the specified elements.
      */
 
-    CLANG_ASSERT(dataArray);
-    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);
+    numElems = (last - first + 1);
+    Tcl_SetListObj(Tcl_GetObjResult(interp), numElems, &(elemPtrs[first]));
     return TCL_OK;
 }
 
@@ -2661,12 +3048,12 @@ Tcl_LrepeatObjCmd(
  *
  * 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.
@@ -2674,173 +3061,100 @@ Tcl_LrepeatObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_LreplaceObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     register Tcl_Obj *listPtr;
-    int first, last, listLen, numToDelete, result;
+    int isDuplicate, first, last, listLen, numToDelete, result;
 
     if (objc < 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"list first last ?element ...?");
+		"list first last ?element element ...?");
 	return TCL_ERROR;
     }
 
-    result = TclListObjLength(interp, objv[1], &listLen);
+    result = Tcl_ListObjLength(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 = TclGetIntForIndexM(interp, objv[2], /*end*/ listLen-1, &first);
+    result = TclGetIntForIndex(interp, objv[2], /*end*/ (listLen - 1), &first);
     if (result != TCL_OK) {
 	return result;
     }
 
-    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
+    result = TclGetIntForIndex(interp, objv[3], /*end*/ (listLen - 1), &last);
     if (result != TCL_OK) {
 	return result;
     }
 
-    if (first < 0) {
-	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_AppendResult(interp, "list doesn't contain element ",
-		TclGetString(objv[2]), NULL);
-        Tcl_SetErrorCode(interp, "TCL","OPERATION","LREPLACE","BADIDX", NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"list doesn't contain element ",
+		Tcl_GetString(objv[2]), (int *) NULL);
 	return TCL_ERROR;
     }
     if (last >= listLen) {
-	last = listLen - 1;
+    	last = (listLen - 1);
     }
     if (first <= last) {
-	numToDelete = last - first + 1;
+	numToDelete = (last - first + 1);
     } else {
 	numToDelete = 0;
     }
 
     /*
-     * 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 = TclListObjCopy(NULL, listPtr);
+	listPtr = Tcl_DuplicateObj(listPtr);
+	isDuplicate = 1;
     }
-
-    /*
-     * 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 (objc > 4) {
+	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+	        (objc-4), &(objv[4]));
+    } else {
+	result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
+		0, NULL);
     }
-    if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
-	return TCL_ERROR;
+    if (result != TCL_OK) {
+	if (isDuplicate) {
+	    Tcl_DecrRefCount(listPtr); /* free unneeded obj */
+	}
+	return result;
     }
 
     /*
-     * If the list is empty, just return it. [Bug 1876793]
+     * Set the interpreter's object result. 
      */
 
-    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]);
-    }
+    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
@@ -2849,8 +3163,8 @@ Tcl_LreverseObjCmd(
  *
  * 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.
@@ -2862,34 +3176,30 @@ Tcl_LreverseObjCmd(
  */
 
 int
-Tcl_LsearchObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument values. */
+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. */
 {
-    const char *bytes, *patternBytes;
-    int i, match, index, result, listc, length, elemLen, bisect;
-    int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
-    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
+    char *bytes, *patternBytes;
+    int i, match, mode, index, result, listc, length, elemLen;
+    int dataType, isIncreasing, lower, upper, patInt, objInt;
+    int offset, allMatches, inlineReturn, negatedMatch;
     double patDouble, objDouble;
-    SortInfo sortInfo;
-    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
-    SortStrCmpFn_t strCmpFn = strcmp;
+    Tcl_Obj *patObj, **listv, *listPtr, *startPtr;
     Tcl_RegExp regexp = NULL;
-    static const char *const options[] = {
-	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
-	"-exact",   "-glob",    "-increasing", "-index",
-	"-inline",  "-integer", "-nocase",     "-not",
-	"-real",    "-regexp",  "-sorted",     "-start",
-	"-subindices", NULL
+    static CONST char *options[] = {
+	"-all",	    "-ascii", "-decreasing", "-dictionary",
+	"-exact",   "-glob",  "-increasing", "-inline",
+	"-integer", "-not",   "-real",	     "-regexp",
+	"-sorted",  "-start", NULL
     };
     enum options {
-	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_BISECT, LSEARCH_DECREASING,
-	LSEARCH_DICTIONARY, 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
+	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
     };
     enum datatypes {
 	ASCII, DICTIONARY, INTEGER, REAL
@@ -2897,41 +3207,29 @@ Tcl_LsearchObjCmd(
     enum modes {
 	EXACT, GLOB, REGEXP, SORTED
     };
-    enum modes mode;
 
     mode = GLOB;
     dataType = ASCII;
     isIncreasing = 1;
     allMatches = 0;
     inlineReturn = 0;
-    returnSubindices = 0;
     negatedMatch = 0;
-    bisect = 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, "?-option value ...? list pattern");
+	Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
 	return TCL_ERROR;
     }
 
     for (i = 1; i < objc-2; i++) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
 		!= TCL_OK) {
-	    if (startPtr != NULL) {
+	    if (startPtr) {
 		Tcl_DecrRefCount(startPtr);
 	    }
-	    result = TCL_ERROR;
-	    goto done;
+	    return TCL_ERROR;
 	}
 	switch ((enum options) index) {
 	case LSEARCH_ALL:		/* -all */
@@ -2940,13 +3238,8 @@ Tcl_LsearchObjCmd(
 	case LSEARCH_ASCII:		/* -ascii */
 	    dataType = ASCII;
 	    break;
-	case LSEARCH_BISECT:		/* -bisect */
-	    mode = SORTED;
-	    bisect = 1;
-	    break;
 	case LSEARCH_DECREASING:	/* -decreasing */
 	    isIncreasing = 0;
-	    sortInfo.isIncreasing = 0;
 	    break;
 	case LSEARCH_DICTIONARY:	/* -dictionary */
 	    dataType = DICTIONARY;
@@ -2959,7 +3252,6 @@ Tcl_LsearchObjCmd(
 	    break;
 	case LSEARCH_INCREASING:	/* -increasing */
 	    isIncreasing = 1;
-	    sortInfo.isIncreasing = 1;
 	    break;
 	case LSEARCH_INLINE:		/* -inline */
 	    inlineReturn = 1;
@@ -2967,10 +3259,6 @@ Tcl_LsearchObjCmd(
 	case LSEARCH_INTEGER:		/* -integer */
 	    dataType = INTEGER;
 	    break;
-	case LSEARCH_NOCASE:		/* -nocase */
-	    strCmpFn = strcasecmp;
-	    noCase = 1;
-	    break;
 	case LSEARCH_NOT:		/* -not */
 	    negatedMatch = 1;
 	    break;
@@ -2983,182 +3271,87 @@ Tcl_LsearchObjCmd(
 	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 != NULL) {
+	    if (startPtr) {
 		Tcl_DecrRefCount(startPtr);
 	    }
 	    if (i > objc-4) {
 		Tcl_AppendResult(interp, "missing starting index", NULL);
-                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		result = TCL_ERROR;
-		goto done;
+		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) {
-		TclStackFree(interp, sortInfo.indexv);
-	    }
-	    if (i > objc-4) {
-		if (startPtr != NULL) {
-		    Tcl_DecrRefCount(startPtr);
-		}
-		Tcl_AppendResult(interp,
-			"\"-index\" option must be followed by list index",
-			NULL);
-                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", 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 =
-			TclStackAlloc(interp, 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) {
-		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			    "\n    (-index option item number %d)", j));
-		    result = TCL_ERROR;
-		    goto done;
-		}
-	    }
-	    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);
-        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
-                "BAD_OPTION_MIX", NULL);
-	return TCL_ERROR;
     }
 
-    if (bisect && (allMatches || negatedMatch)) {
-	Tcl_AppendResult(interp,
-		"-bisect is not compatible with -all or -not", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
-                "BAD_OPTION_MIX", NULL);
-	return TCL_ERROR;
-    }
-
-    if (mode == REGEXP) {
+    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 |
-		(noCase ? TCL_REG_NOCASE : 0));
+		TCL_REG_ADVANCED | TCL_REG_NOSUB);
 	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.
-	     */
+            /*
+             * 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));
+            regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
+		    TCL_REG_ADVANCED);
 	}
 
 	if (regexp == NULL) {
-	    if (startPtr != NULL) {
+	    if (startPtr) {
 		Tcl_DecrRefCount(startPtr);
 	    }
-	    result = TCL_ERROR;
-	    goto done;
+	    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 = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
+    result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
     if (result != TCL_OK) {
-	if (startPtr != NULL) {
+	if (startPtr) {
 	    Tcl_DecrRefCount(startPtr);
 	}
-	goto done;
+	return result;
     }
 
     /*
      * Get the user-specified start offset.
      */
-
     if (startPtr) {
-	result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
+	result = TclGetIntForIndex(interp, startPtr, listc-1, &offset);
 	Tcl_DecrRefCount(startPtr);
 	if (result != TCL_OK) {
-	    goto done;
-	}
-	if (offset < 0) {
-	    offset = 0;
+	    return result;
 	}
 
 	/*
@@ -3167,9 +3360,6 @@ Tcl_LsearchObjCmd(
 	 */
 
 	if (offset > listc-1) {
-	    if (sortInfo.indexc > 1) {
-		TclStackFree(interp, sortInfo.indexv);
-	    }
 	    if (allMatches || inlineReturn) {
 		Tcl_ResetResult(interp);
 	    } else {
@@ -3177,89 +3367,71 @@ Tcl_LsearchObjCmd(
 	    }
 	    return TCL_OK;
 	}
+	if (offset < 0) {
+	    offset = 0;
+	}
     }
 
     patObj = objv[objc - 1];
     patternBytes = NULL;
-    if (mode == EXACT || mode == SORTED) {
+    if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) {
 	switch ((enum datatypes) dataType) {
 	case ASCII:
 	case DICTIONARY:
-	    patternBytes = TclGetStringFromObj(patObj, &length);
+	    patternBytes = Tcl_GetStringFromObj(patObj, &length);
 	    break;
 	case INTEGER:
-	    result = TclGetIntFromObj(interp, patObj, &patInt);
+	    result = Tcl_GetIntFromObj(interp, patObj, &patInt);
 	    if (result != TCL_OK) {
-		goto done;
+		return result;
 	    }
-
-	    /*
-	     * List representation might have been shimmered; restore it. [Bug
-	     * 1844789]
-	     */
-
-	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
+	    Tcl_ListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
 	    break;
 	case REAL:
 	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
 	    if (result != TCL_OK) {
-		goto done;
+		return result;
 	    }
-
-	    /*
-	     * List representation might have been shimmered; restore it. [Bug
-	     * 1844789]
-	     */
-
-	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
+	    Tcl_ListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
 	    break;
 	}
     } else {
-	patternBytes = TclGetStringFromObj(patObj, &length);
+	patternBytes = Tcl_GetStringFromObj(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 (mode == SORTED && !allMatches && !negatedMatch) {
+    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 && sortInfo.resultCode == TCL_OK) {
+	while (lower + 1 != upper) {
 	    i = (lower + upper)/2;
-	    if (sortInfo.indexc != 0) {
-		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
-		if (sortInfo.resultCode != TCL_OK) {
-		    result = sortInfo.resultCode;
-		    goto done;
-		}
-	    } else {
-		itemPtr = listv[i];
-	    }
 	    switch ((enum datatypes) dataType) {
 	    case ASCII:
-		bytes = TclGetString(itemPtr);
-		match = strCmpFn(patternBytes, bytes);
+		bytes = Tcl_GetString(listv[i]);
+		match = strcmp(patternBytes, bytes);
 		break;
 	    case DICTIONARY:
-		bytes = TclGetString(itemPtr);
+		bytes = Tcl_GetString(listv[i]);
 		match = DictionaryCompare(patternBytes, bytes);
 		break;
 	    case INTEGER:
-		result = TclGetIntFromObj(interp, itemPtr, &objInt);
+		result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
 		if (result != TCL_OK) {
-		    goto done;
+		    return result;
 		}
 		if (patInt == objInt) {
 		    match = 0;
@@ -3270,9 +3442,9 @@ Tcl_LsearchObjCmd(
 		}
 		break;
 	    case REAL:
-		result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
+		result = Tcl_GetDoubleFromObj(interp, listv[i], &objDouble);
 		if (result != TCL_OK) {
-		    goto done;
+		    return result;
 		}
 		if (patDouble == objDouble) {
 		    match = 0;
@@ -3285,27 +3457,19 @@ Tcl_LsearchObjCmd(
 	    }
 	    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).
-		 *
-		 * In bisect mode though, we want the last of equals.
+		 * comparisons (normal binary search might "get lucky" with
+		 * an early comparison).
 		 */
-
 		index = i;
-		if (bisect) {
-		    lower = i;
-		} else {
-		    upper = i;
-		}
+		upper = i;
 	    } else if (match > 0) {
 		if (isIncreasing) {
 		    lower = i;
@@ -3320,9 +3484,7 @@ Tcl_LsearchObjCmd(
 		}
 	    }
 	}
-	if (bisect && index < 0) {
-	    index = lower;
-	}
+
     } else {
 	/*
 	 * We need to do a linear search, because (at least one) of:
@@ -3330,128 +3492,83 @@ Tcl_LsearchObjCmd(
 	 *   - our matching sense is negated
 	 *   - we're building a list of all matched items
 	 */
-
 	if (allMatches) {
-	    listPtr = Tcl_NewListObj(0, NULL);
+	    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) 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);
-		    }
-		    result = sortInfo.resultCode;
-		    goto done;
-		}
-	    } else {
-		itemPtr = listv[i];
-	    }
-
-	    switch (mode) {
+	    switch ((enum modes) mode) {
 	    case SORTED:
 	    case EXACT:
 		switch ((enum datatypes) dataType) {
 		case ASCII:
-		    bytes = TclGetStringFromObj(itemPtr, &elemLen);
+		    bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
 		    if (length == elemLen) {
-			/*
-			 * 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);
-			}
+			match = (memcmp(bytes, patternBytes,
+				(size_t) length) == 0);
 		    }
 		    break;
-
 		case DICTIONARY:
-		    bytes = TclGetString(itemPtr);
+		    bytes = Tcl_GetString(listv[i]);
 		    match = (DictionaryCompare(bytes, patternBytes) == 0);
 		    break;
-
 		case INTEGER:
-		    result = TclGetIntFromObj(interp, itemPtr, &objInt);
+		    result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
 		    if (result != TCL_OK) {
-			if (listPtr != NULL) {
+			if (listPtr) {
 			    Tcl_DecrRefCount(listPtr);
 			}
-			goto done;
+			return result;
 		    }
 		    match = (objInt == patInt);
 		    break;
-
 		case REAL:
-		    result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble);
+		    result = Tcl_GetDoubleFromObj(interp, listv[i],
+			    &objDouble);
 		    if (result != TCL_OK) {
 			if (listPtr) {
 			    Tcl_DecrRefCount(listPtr);
 			}
-			goto done;
+			return result;
 		    }
 		    match = (objDouble == patDouble);
 		    break;
 		}
 		break;
-
 	    case GLOB:
-		match = Tcl_StringCaseMatch(TclGetString(itemPtr),
-			patternBytes, noCase);
+		match = Tcl_StringMatch(Tcl_GetString(listv[i]),
+			patternBytes);
 		break;
-
 	    case REGEXP:
-		match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
+		match = Tcl_RegExpExecObj(interp, regexp, listv[i], 0, 0, 0);
 		if (match < 0) {
 		    Tcl_DecrRefCount(patObj);
-		    if (listPtr != NULL) {
+		    if (listPtr) {
 			Tcl_DecrRefCount(listPtr);
 		    }
-		    result = TCL_ERROR;
-		    goto done;
+		    return TCL_ERROR;
 		}
 		break;
 	    }
-
 	    /*
-	     * Invert match condition for -not.
+	     * Invert match condition for -not
 	     */
-
 	    if (negatedMatch) {
 		match = !match;
 	    }
-	    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);
+	    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]);
 		} else {
-		    itemPtr = listv[i];
+		    Tcl_ListObjAppendElement(interp, listPtr,
+			    Tcl_NewIntObj(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));
 	    }
 	}
     }
@@ -3459,43 +3576,20 @@ Tcl_LsearchObjCmd(
     /*
      * Return everything or a single value.
      */
-
     if (allMatches) {
 	Tcl_SetObjResult(interp, listPtr);
     } else if (!inlineReturn) {
-	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));
-	}
+	Tcl_SetIntObj(Tcl_GetObjResult(interp), 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]);
     }
-    result = TCL_OK;
-
-    /*
-     * Cleanup the index list array.
-     */
-
-  done:
-    if (sortInfo.indexc > 1) {
-	TclStackFree(interp, sortInfo.indexv);
-    }
-    return result;
+    return TCL_OK;
 }
 
 /*
@@ -3503,8 +3597,8 @@ Tcl_LsearchObjCmd(
  *
  * 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.
@@ -3516,71 +3610,66 @@ Tcl_LsearchObjCmd(
  */
 
 int
-Tcl_LsetObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument values. */
+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_Obj *listPtr;		/* Pointer to the list being altered. */
-    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */
 
-    /*
-     * Check parameter count.
-     */
+    Tcl_Obj* listPtr;		/* Pointer to the list being altered. */
+    Tcl_Obj* finalValuePtr;	/* Value finally assigned to the variable */
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-                "listVar ?index? ?index ...? value");
+    /* Check parameter count */
+
+    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], 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;
+
 }
 
 /*
@@ -3588,8 +3677,8 @@ Tcl_LsetObjCmd(
  *
  * 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.
@@ -3601,37 +3690,29 @@ Tcl_LsetObjCmd(
  */
 
 int
-Tcl_LsortObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument values. */
+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. */
 {
-    int i, j, index, indices, length, nocase = 0, sortMode, indexc;
-    int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
-    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. */
-#   define NUM_LISTS 30
-    SortElement *subList[NUM_LISTS+1];
-				/* This array holds pointers to temporary
-				 * lists built during the merge sort. Element
-				 * i of the array holds a list of length
-				 * 2**i. */
-    static const char *const switches[] = {
+    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[] = {
 	"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
-	"-index", "-indices", "-integer", "-nocase", "-real", "-stride",
-	"-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_STRIDE, LSORT_UNIQUE
+	"-index", "-integer", "-real", "-unique", (char *) NULL
     };
 
+    resultPtr = Tcl_GetObjResult(interp);
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list");
+	Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
 	return TCL_ERROR;
     }
 
@@ -3641,423 +3722,199 @@ Tcl_LsortObjCmd(
 
     sortInfo.isIncreasing = 1;
     sortInfo.sortMode = SORTMODE_ASCII;
-    sortInfo.indexv = NULL;
-    sortInfo.indexc = 0;
-    sortInfo.unique = 0;
+    sortInfo.index = SORTIDX_NONE;
     sortInfo.interp = interp;
     sortInfo.resultCode = TCL_OK;
     cmdPtr = NULL;
-    indices = 0;
-    group = 0;
-    groupSize = 1;
-    groupOffset = 0;
-    indexPtr = NULL;
+    unique = 0;
     for (i = 1; i < objc-1; i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
-		&index) != TCL_OK) {
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done2;
+	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
+		!= TCL_OK) {
+	    return TCL_ERROR;
 	}
-	switch ((enum Lsort_Switches) index) {
-	case LSORT_ASCII:
-	    sortInfo.sortMode = SORTMODE_ASCII;
-	    break;
-	case LSORT_COMMAND:
-	    if (i == objc-2) {
-		Tcl_AppendResult(interp,
-			"\"-command\" option must be followed "
-			"by comparison command", NULL);
-                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    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: {
-            int indexc, dummy;
-	    Tcl_Obj **indexv;
-
-	    if (i == objc-2) {
-		Tcl_AppendResult(interp, "\"-index\" option must be "
-			"followed by list index", NULL);
-                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-                sortInfo.resultCode = TCL_ERROR;
-                goto done2;
-	    }
-	    if (TclListObjGetElements(interp, objv[i+1], &indexc,
-		    &indexv) != TCL_OK) {
-                sortInfo.resultCode = TCL_ERROR;
-                goto done2;
-	    }
-
-            /*
-             * Check each of the indices for syntactic correctness. Note that
-             * we do not store the converted values here because we do not
-             * know if this is the only -index option yet and so we can't
-             * allocate any space; that happens after the scan through all the
-             * options is done.
-             */
-
-	    for (j=0 ; j<indexc ; j++) {
-		if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
-			&dummy) != TCL_OK) {
-		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			    "\n    (-index option item number %d)", j));
-		    sortInfo.resultCode = TCL_ERROR;
-		    goto done2;
+	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;
 		}
-	    }
-	    indexPtr = objv[i+1];
-            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;
-	case LSORT_STRIDE:
-	    if (i == objc-2) {
-		Tcl_AppendResult(interp, "\"-stride\" option must be ",
-			"followed by stride length", NULL);
-                Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    if (groupSize < 2) {
-		Tcl_AppendResult(interp, "stride length must be at least 2",
-			NULL);
-                Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
-                        "BADSTRIDE", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done2;
-	    }
-	    group = 1;
-	    i++;
-	    break;
+		sortInfo.sortMode = SORTMODE_COMMAND;
+		cmdPtr = objv[i+1];
+		i++;
+		break;
+	    case 2:			/* -decreasing */
+		sortInfo.isIncreasing = 0;
+		break;
+	    case 3:			/* -dictionary */
+		sortInfo.sortMode = SORTMODE_DICTIONARY;
+		break;
+	    case 4:			/* -increasing */
+		sortInfo.isIncreasing = 1;
+		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) {
+		    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;
 	}
     }
-    if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
-	sortInfo.sortMode = SORTMODE_ASCII_NC;
-    }
-
-    /*
-     * Now extract the -index list for real, if present. No failures are
-     * expected here; the values are all of the right type or convertible to
-     * it.
-     */
-
-    if (indexPtr) {
-        Tcl_Obj **indexv;
-
-        TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
-        switch (sortInfo.indexc) {
-        case 0:
-            sortInfo.indexv = NULL;
-            break;
-        case 1:
-            sortInfo.indexv = &sortInfo.singleIndex;
-            break;
-        default:
-            sortInfo.indexv =
-		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
-            allocatedIndexVector = 1;	/* Cannot use indexc field, as it
-                                         * might be decreased by 1 later. */
-        }
-        for (j=0 ; j<sortInfo.indexc ; j++) {
-            TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
-		    &sortInfo.indexv[j]);
-        }
-    }
-
-    listObj = objv[objc-1];
-
     if (sortInfo.sortMode == SORTMODE_COMMAND) {
-	Tcl_Obj *newCommandPtr, *newObjPtr;
-
 	/*
-	 * 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]
+	 * The existing command is a list. We want to flatten it, append
+	 * two dummy arguments on the end, and replace these arguments
+	 * later.
 	 */
 
-	listObj = TclListObjCopy(interp, listObj);
-	if (listObj == NULL) {
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done2;
-	}
+        Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
+	Tcl_Obj *newObjPtr = Tcl_NewObj();
 
-	/*
-	 * 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) {
-	    TclDecrRefCount(newCommandPtr);
-	    TclDecrRefCount(listObj);
+	    Tcl_DecrRefCount(newCommandPtr);
 	    Tcl_IncrRefCount(newObjPtr);
-	    TclDecrRefCount(newObjPtr);
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done2;
+	    Tcl_DecrRefCount(newObjPtr);
+	    return TCL_ERROR;
 	}
 	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
 	sortInfo.compareCmdPtr = newCommandPtr;
     }
 
-    sortInfo.resultCode = TclListObjGetElements(interp, listObj,
+    sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
 	    &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];
 
-    /*
-     * Check for sanity when grouping elements of the overall list together
-     * because of the -stride option. [TIP #326]
-     */
-
-    if (group) {
-	if (length % groupSize) {
-	    Tcl_AppendResult(interp,
-		    "list size must be a multiple of the stride length",
-		    NULL);
-            Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
-                    NULL);
-	    sortInfo.resultCode = TCL_ERROR;
-	    goto done;
-	}
-	length = length / groupSize;
-	if (sortInfo.indexc > 0) {
-	    /*
-	     * Use the first value in the list supplied to -index as the
-	     * offset of the element within each group by which to sort.
-	     */
-
-	    groupOffset = sortInfo.indexv[0];
-	    if (groupOffset <= SORTIDX_END) {
-		groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
-	    }
-	    if (groupOffset < 0 || groupOffset >= groupSize) {
-		Tcl_AppendResult(interp, "when used with \"-stride\", the "
-			"leading \"-index\" value must be within the group",
-			NULL);
-                Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
-                        "BADINDEX", NULL);
-		sortInfo.resultCode = TCL_ERROR;
-		goto done;
-	    }
-	    if (sortInfo.indexc == 1) {
-		sortInfo.indexc = 0;
-		sortInfo.indexv = NULL;
-	    } else {
-		sortInfo.indexc--;
-
-		/*
-		 * Do not shrink the actual memory block used; that doesn't
-		 * work with TclStackAlloc-allocated memory. [Bug 2918962]
-		 */
-
-		for (i = 0; i < sortInfo.indexc; i++) {
-		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
-		}
-	    }
-	}
-    }
-
-    sortInfo.numElements = length;
-
-    indexc = sortInfo.indexc;
-    sortMode = sortInfo.sortMode;
-    if ((sortMode == SORTMODE_ASCII_NC)
-	    || (sortMode == SORTMODE_DICTIONARY)) {
 	/*
-	 * For this function's purpose all string-based modes are equivalent
+	 * 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]
 	 */
 
-	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;
-    }
-
-    /*
-     * The following loop creates a SortElement for each list element and
-     * begins sorting it into the sublists as it appears.
-     */
-
-    elementArray = TclStackAlloc(interp, length * sizeof(SortElement));
-
-    for (i=0; i < length; i++){
-	idx = groupSize * i + groupOffset;
-	if (indexc) {
-	    /*
-	     * If this is an indexed sort, retrieve the corresponding element
-	     */
-	    indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
-	    if (sortInfo.resultCode != TCL_OK) {
-		goto done1;
-	    }
-	} else {
-	    indexPtr = listObjPtrs[idx];
-	}
-
+    elementArray[length-1].nextPtr = NULL;
+    elementPtr = MergeSort(elementArray, &sortInfo);
+    if (sortInfo.resultCode == TCL_OK) {
 	/*
-	 * Determine the "value" of this object for sorting purposes
+	 * Note: must clear the interpreter's result object: it could
+	 * have been set by the -command script.
 	 */
 
-	if (sortMode == SORTMODE_ASCII) {
-	    elementArray[i].collationKey.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].collationKey.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;
+	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);
+		}
 	    }
-	    elementArray[i].collationKey.doubleValue = a;
-	} else {
-	    elementArray[i].collationKey.objValuePtr = indexPtr;
-	}
-
-	/*
-	 * Determine the representation of this element in the result: either
-	 * the objPtr itself, or its index in the original list.
-	 */
-
-	if (indices || group) {
-	    elementArray[i].payload.index = idx;
 	} else {
-	    elementArray[i].payload.objPtr = listObjPtrs[idx];
-	}
-
-	/*
-	 * 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;
+	    for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+		Tcl_ListObjAppendElement(interp, resultPtr,
+			elementPtr->objPtr);
+	    }
 	}
-	subList[j] = elementPtr;
     }
+    for (i=0; i<length; i++) {
+	Tcl_DecrRefCount(elementArray[i].objPtr);
+    }
+    ckfree((char*) elementArray);
 
-    /*
-     * Merge all sublists
-     */
-
-    elementPtr = subList[0];
-    for (j=1 ; j<NUM_LISTS ; j++) {
-	elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
+    done:
+    if (sortInfo.sortMode == SORTMODE_COMMAND) {
+	Tcl_DecrRefCount(sortInfo.compareCmdPtr);
+	sortInfo.compareCmdPtr = NULL;
     }
+    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 */
+{
     /*
-     * Now store the sorted elements in the result list.
+     * 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.
      */
 
-    if (sortInfo.resultCode == TCL_OK) {
-	List *listRepPtr;
-	Tcl_Obj **newArray, *objPtr;
-
-	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
-	listRepPtr = ListRepPtr(resultPtr);
-	newArray = &listRepPtr->elements;
-	if (group) {
-	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
-		idx = elementPtr->payload.index;
-		for (j = 0; j < groupSize; j++) {
-		    if (indices) {
-			objPtr = Tcl_NewIntObj(idx + j - groupOffset);
-			newArray[i++] = objPtr;
-			Tcl_IncrRefCount(objPtr);
-		    } else {
-			objPtr = listObjPtrs[idx + j - groupOffset];
-			newArray[i++] = objPtr;
-			Tcl_IncrRefCount(objPtr);
-		    }
-		}
-	    }
-	} else if (indices) {
-	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
-		objPtr = Tcl_NewIntObj(elementPtr->payload.index);
-		newArray[i++] = objPtr;
-		Tcl_IncrRefCount(objPtr);
-	    }
-	} else {
-	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
-		objPtr = elementPtr->payload.objPtr;
-		newArray[i++] = objPtr;
-		Tcl_IncrRefCount(objPtr);
-	    }
-	}
-	listRepPtr->elemCount = i;
-	Tcl_SetObjResult(interp, resultPtr);
-    }
-
-  done1:
-    TclStackFree(interp, elementArray);
+#   define NUM_LISTS 30
+    SortElement *subList[NUM_LISTS];
+    SortElement *elementPtr;
+    int i;
 
-  done:
-    if (sortInfo.sortMode == SORTMODE_COMMAND) {
-	TclDecrRefCount(sortInfo.compareCmdPtr);
-	TclDecrRefCount(listObj);
-	sortInfo.compareCmdPtr = NULL;
+    for(i = 0; i < NUM_LISTS; i++){
+        subList[i] = NULL;
     }
-  done2:
-    if (allocatedIndexVector) {
-	TclStackFree(interp, sortInfo.indexv);
+    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;
+	}
+	subList[i] = elementPtr;
     }
-    return sortInfo.resultCode;
+    elementPtr = NULL;
+    for (i = 0; i < NUM_LISTS; i++){
+        elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
+    }
+    return elementPtr;
 }
 
 /*
@@ -4069,93 +3926,65 @@ Tcl_LsortObjCmd(
  *	into a single sorted list.
  *
  * Results:
- *	The unified list of SortElement structures.
+ *      The unified list of SortElement structures.
  *
  * Side effects:
- *	If infoPtr->unique is set then infoPtr->numElements may be updated.
- *	Possibly others, if a user-defined comparison command does something
+ *	None, unless 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(
-    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(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. */
 {
-    SortElement *headPtr, *tailPtr;
+    SortElement *headPtr;
+    SortElement *tailPtr;
     int cmp;
 
     if (leftPtr == NULL) {
-	return rightPtr;
+        return rightPtr;
     }
     if (rightPtr == NULL) {
-	return leftPtr;
+        return leftPtr;
     }
-    cmp = SortCompare(leftPtr, rightPtr, infoPtr);
-    if (cmp > 0 || (cmp == 0 && infoPtr->unique)) {
-	if (cmp == 0) {
-	    infoPtr->numElements--;
-	    leftPtr = leftPtr->nextPtr;
-	}
+    cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
+    if (cmp > 0) {
 	tailPtr = rightPtr;
 	rightPtr = rightPtr->nextPtr;
     } else {
+	if (cmp == 0) {
+	    leftPtr->count++;
+	}
 	tailPtr = leftPtr;
 	leftPtr = leftPtr->nextPtr;
     }
     headPtr = tailPtr;
-    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;
+    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++;
 	    }
+	    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;
 }
@@ -4169,99 +3998,163 @@ MergeLists(
  *	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(
-    SortElement *elemPtr1, SortElement *elemPtr2,
-				/* Values to be compared. */
-    SortInfo *infoPtr)		/* Information passed from the top-level
-				 * "lsort" command. */
+SortCompare(objPtr1, objPtr2, infoPtr)
+    Tcl_Obj *objPtr1, *objPtr2;		/* Values to be compared. */
+    SortInfo *infoPtr;                  /* Information passed from the
+                                         * top-level "lsort" command */
 {
-    int order = 0;
+    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;
+	}
+
+	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(elemPtr1->collationKey.strValuePtr,
-		elemPtr2->collationKey.strValuePtr);
-    } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
-	order = strcasecmp(elemPtr1->collationKey.strValuePtr,
-		elemPtr2->collationKey.strValuePtr);
+	order = strcmp(Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
     } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
-	order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
-		elemPtr2->collationKey.strValuePtr);
+	order = DictionaryCompare(
+		Tcl_GetString(objPtr1),	Tcl_GetString(objPtr2));
     } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
 	long a, b;
 
-	a = elemPtr1->collationKey.intValue;
-	b = elemPtr2->collationKey.intValue;
-	order = ((a >= b) - (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;
+	}
     } else if (infoPtr->sortMode == SORTMODE_REAL) {
 	double a, b;
 
-	a = elemPtr1->collationKey.doubleValue;
-	b = elemPtr2->collationKey.doubleValue;
-	order = ((a >= b) - (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;
+	}
     } 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->collationKey.objValuePtr;
-	objPtr2 = elemPtr2->collationKey.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.
 	 */
 
-	TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
+	Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
 	Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
 		2, 2, paramObjv);
-	TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+   	Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
 		&objc, &objv);
 
 	infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
-
-	if (infoPtr->resultCode != TCL_OK) {
-	    Tcl_AddErrorInfo(infoPtr->interp, "\n    (-compare command)");
-	    return 0;
+  
+  	if (infoPtr->resultCode != TCL_OK) {
+	    Tcl_AddErrorInfo(infoPtr->interp,
+		    "\n    (-compare command)");
+	    return order;
 	}
 
 	/*
 	 * Parse the result of the command.
 	 */
 
-	if (TclGetIntFromObj(infoPtr->interp,
+	if (Tcl_GetIntFromObj(infoPtr->interp,
 		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
 	    Tcl_ResetResult(infoPtr->interp);
-	    Tcl_AppendResult(infoPtr->interp,
-		    "-compare command returned non-integer result", NULL);
-            Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
-                    "COMPARISONFAILED", NULL);
+	    Tcl_AppendToObj(Tcl_GetObjResult(infoPtr->interp),
+		    "-compare command returned non-integer result", -1);
 	    infoPtr->resultCode = TCL_ERROR;
-	    return 0;
+	    return order;
 	}
     }
     if (!infoPtr->isIncreasing) {
@@ -4275,18 +4168,18 @@ SortCompare(
  *
  * 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.
@@ -4295,29 +4188,30 @@ SortCompare(
  */
 
 static int
-DictionaryCompare(
-    const char *left, const char *right)	/* The strings to compare. */
+DictionaryCompare(left, right)
+    char *left, *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;
-	    while ((*right == '0') && isdigit(UCHAR(right[1]))) {
+	    while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
 		right++;
 		zeros--;
 	    }
-	    while ((*left == '0') && isdigit(UCHAR(left[1]))) {
+	    while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
 		left++;
 		zeros++;
 	    }
@@ -4326,10 +4220,10 @@ DictionaryCompare(
 	    }
 
 	    /*
-	     * 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;
@@ -4339,13 +4233,13 @@ DictionaryCompare(
 		}
 		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) {
@@ -4353,7 +4247,7 @@ DictionaryCompare(
 			}
 			break;
 		    }
-		} else if (!isdigit(UCHAR(*left))) {	/* INTL: digit */
+		} else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
 		    return -1;
 		}
 	    }
@@ -4361,7 +4255,7 @@ DictionaryCompare(
 	}
 
 	/*
-	 * 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.
 	 */
@@ -4369,14 +4263,12 @@ DictionaryCompare(
 	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 {
@@ -4384,18 +4276,18 @@ DictionaryCompare(
 	    break;
 	}
 
-	diff = uniLeftLower - uniRightLower;
-	if (diff) {
+        diff = uniLeftLower - uniRightLower;
+        if (diff) {
 	    return diff;
-	}
-	if (secondaryDiff == 0) {
-	    if (Tcl_UniCharIsUpper(uniLeft) && Tcl_UniCharIsLower(uniRight)) {
+	} else 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;
@@ -4404,91 +4296,10 @@ DictionaryCompare(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * 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) {
-            Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
-                    "element %d missing from sublist \"%s\"",
-                    index, TclGetString(objPtr)));
-            Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
-                    "INDEXFAILED", NULL);
-	    infoPtr->resultCode = TCL_ERROR;
-	    return NULL;
-	}
-	objPtr = currentObj;
-    }
-    return objPtr;
-}
-
-/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
  * End:
  */
+
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index c5bb72d..4ada397 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1,53 +1,153 @@
-/*
+/* 
  * 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-2009 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"
 
-static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
-			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
-static int		SwitchPostProc(ClientData data[], Tcl_Interp *interp,
-			    int result);
-static int		TryPostBody(ClientData data[], Tcl_Interp *interp,
-			    int result);
-static int		TryPostFinal(ClientData data[], Tcl_Interp *interp,
-			    int result);
-static int		TryPostHandler(ClientData data[], Tcl_Interp *interp,
-			    int result);
-static int		UniCharIsAscii(int character);
-static int		UniCharIsHexDigit(int character);
+/*
+ * 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;
 
 /*
- * Default set of characters to trim in [string trim] and friends. This is a
- * UTF-8 literal string containing space, tab, newline, carriage return,
- * ethiopic wordspace (U+1361), ogham space mark (U+1680), and ideographic
- * space (U+3000). [TIP #318]
+ * Structure used to hold information about command traces:
  */
 
-#define DEFAULT_TRIM_SET " \t\n\r\xe1\x8d\xa1\xe1\x9a\x80\xe3\x80\x80"
-
+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
 /*
  *----------------------------------------------------------------------
  *
  * 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.
@@ -58,12 +158,13 @@ static int		UniCharIsHexDigit(int character);
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_PwdObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *retVal;
 
@@ -86,8 +187,8 @@ Tcl_PwdObjCmd(
  *
  * 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.
@@ -98,22 +199,23 @@ Tcl_PwdObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_RegexpObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int i, indices, match, about, offset, all, doinline, numMatchesSaved;
-    int cflags, eflags, stringLength, matchLength;
+    int cflags, eflags, stringLength;
     Tcl_RegExp regExpr;
-    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
+    Tcl_Obj *objPtr, *resultPtr;
     Tcl_RegExpInfo info;
-    static const char *const options[] = {
+    static CONST char *options[] = {
 	"-all",		"-about",	"-indices",	"-inline",
 	"-expanded",	"-line",	"-linestop",	"-lineanchor",
-	"-nocase",	"-start",	"--",		NULL
+	"-nocase",	"-start",	"--",		(char *) NULL
     };
     enum options {
 	REGEXP_ALL,	REGEXP_ABOUT,	REGEXP_INDICES,	REGEXP_INLINE,
@@ -121,179 +223,165 @@ Tcl_RegexpObjCmd(
 	REGEXP_NOCASE,	REGEXP_START,	REGEXP_LAST
     };
 
-    indices = 0;
-    about = 0;
-    cflags = TCL_REG_ADVANCED;
-    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++) {
-	const char *name;
+	char *name;
 	int index;
 
-	name = TclGetString(objv[i]);
+	name = Tcl_GetString(objv[i]);
 	if (name[0] != '-') {
 	    break;
 	}
 	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
 		&index) != TCL_OK) {
-	    goto optionError;
+	    return TCL_ERROR;
 	}
 	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_START: {
-	    int temp;
-	    if (++i >= objc) {
-		goto endOfForLoop;
+	    case REGEXP_ALL: {
+		all = 1;
+		break;
 	    }
-	    if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) {
-		goto optionError;
+	    case REGEXP_INDICES: {
+		indices = 1;
+		break;
 	    }
-	    if (startIndex) {
-		Tcl_DecrRefCount(startIndex);
+	    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: {
+		if (++i >= objc) {
+		    goto endOfForLoop;
+		}
+		if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (offset < 0) {
+		    offset = 0;
+		}
+		break;
+	    }
+	    case REGEXP_LAST: {
+		i++;
+		goto endOfForLoop;
 	    }
-	    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,
-	    "?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
-	goto optionError;
+	Tcl_WrongNumArgs(interp, 1, objv, 
+	  "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
+	return TCL_ERROR;
     }
     objc -= i;
     objv += i;
 
-    /*
-     * Check if the user requested -inline, but specified match variables; a
-     * no-no.
-     */
-
     if (doinline && ((objc - 2) != 0)) {
-	Tcl_AppendResult(interp, "regexp match variables not allowed"
-		" when using -inline", NULL);
-	goto optionError;
+	/*
+	 * 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;
     }
 
     /*
      * 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) {
-	/*
-	 * 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 /* offset */, numMatchesSaved, eflags 
+		| ((offset > 0 && offset < stringLength &&
+		   (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n'))
+		   ? TCL_REG_NOTBOL : 0));
 
-	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
-		numMatchesSaved, eflags);
 	if (match < 0) {
 	    return TCL_ERROR;
 	}
@@ -303,16 +391,16 @@ Tcl_RegexpObjCmd(
 	     * 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, the interpreter's object result remains an
-		 * empty list, otherwise set it to an integer object w/ value
-		 * 0.
+		 * If inlining, set the interpreter's object result to an
+		 * empty list, otherwise set it to an integer object w/
+		 * value 0.
 		 */
-
-		if (!doinline) {
-		    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+		if (doinline) {
+		    Tcl_SetListObj(resultPtr, 0, NULL);
+		} else {
+		    Tcl_SetIntObj(resultPtr, 0);
 		}
 		return TCL_OK;
 	    }
@@ -320,21 +408,17 @@ Tcl_RegexpObjCmd(
 	}
 
 	/*
-	 * 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;
@@ -344,13 +428,12 @@ Tcl_RegexpObjCmd(
 		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
@@ -362,7 +445,7 @@ Tcl_RegexpObjCmd(
 		    }
 		} else {
 		    start = -1;
-		    end = -1;
+		    end   = -1;
 		}
 
 		objs[0] = Tcl_NewLongObj(start);
@@ -382,12 +465,15 @@ Tcl_RegexpObjCmd(
 		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
 			!= TCL_OK) {
 		    Tcl_DecrRefCount(newPtr);
-		    Tcl_DecrRefCount(resultPtr);
 		    return TCL_ERROR;
 		}
 	    } else {
-		if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr,
-			TCL_LEAVE_ERR_MSG) == NULL) {
+		Tcl_Obj *valuePtr;
+		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);
 		    return TCL_ERROR;
 		}
 	    }
@@ -396,45 +482,37 @@ Tcl_RegexpObjCmd(
 	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;
-
 	/*
-	 * A match of length zero could happen for {^} {$} or {.*} and in
-	 * these cases we always want to bump the index up one.
+	 * 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).
 	 */
-
-	if (matchLength == 0) {
+	if (info.matches[0].end == 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).
+     * 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).
      */
 
-    if (doinline) {
-	Tcl_SetObjResult(interp, resultPtr);
-    } else {
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1));
+    if (!doinline) {
+	resultPtr = Tcl_GetObjResult(interp);
+	Tcl_SetIntObj(resultPtr, (all ? all-1 : 1));
     }
     return TCL_OK;
 }
@@ -444,8 +522,8 @@ Tcl_RegexpObjCmd(
  *
  * 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.
@@ -456,21 +534,22 @@ Tcl_RegexpObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_RegsubObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     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, *startIndex = NULL;
+    Tcl_Obj *resultPtr, *subPtr, *objPtr;
     Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
 
-    static const char *const options[] = {
+    static CONST char *options[] = {
 	"-all",		"-nocase",	"-expanded",
 	"-line",	"-linestop",	"-lineanchor",	"-start",
 	"--",		NULL
@@ -487,109 +566,97 @@ Tcl_RegsubObjCmd(
     resultPtr = NULL;
 
     for (idx = 1; idx < objc; idx++) {
-	const char *name;
+	char *name;
 	int index;
-
-	name = TclGetString(objv[idx]);
+	
+	name = Tcl_GetString(objv[idx]);
 	if (name[0] != '-') {
 	    break;
 	}
 	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
 		TCL_EXACT, &index) != TCL_OK) {
-	    goto optionError;
+	    return TCL_ERROR;
 	}
 	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_START: {
-	    int temp;
-	    if (++idx >= objc) {
-		goto endOfForLoop;
+	    case REGSUB_ALL: {
+		all = 1;
+		break;
 	    }
-	    if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) {
-		goto optionError;
+	    case REGSUB_NOCASE: {
+		cflags |= TCL_REG_NOCASE;
+		break;
 	    }
-	    if (startIndex) {
-		Tcl_DecrRefCount(startIndex);
+	    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: {
+		if (++idx >= objc) {
+		    goto endOfForLoop;
+		}
+		if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (offset < 0) {
+		    offset = 0;
+		}
+		break;
+	    }
+	    case REGSUB_LAST: {
+		idx++;
+		goto endOfForLoop;
 	    }
-	    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,
-		"?-switch ...? exp string subSpec ?varName?");
-    optionError:
-	if (startIndex) {
-	    Tcl_DecrRefCount(startIndex);
-	}
+		"?switches? exp string subSpec ?varName?");
 	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(TclGetString(objv[2]), "&\\") == NULL)
-	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
+	    && (strpbrk(Tcl_GetString(objv[2]), "&\\") == NULL)
+	    && (strpbrk(Tcl_GetString(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)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
+	int (*strCmpFn)_ANSI_ARGS_((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);
@@ -603,9 +670,10 @@ Tcl_RegsubObjCmd(
 	} 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);
@@ -639,9 +707,9 @@ Tcl_RegsubObjCmd(
     }
 
     /*
-     * 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]) {
@@ -660,27 +728,27 @@ Tcl_RegsubObjCmd(
     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;
@@ -694,10 +762,9 @@ Tcl_RegsubObjCmd(
 	    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);
 	    }
 	}
@@ -715,7 +782,7 @@ Tcl_RegsubObjCmd(
 
 	/*
 	 * 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.
 	 */
@@ -743,12 +810,10 @@ Tcl_RegsubObjCmd(
 	    } 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;
@@ -757,21 +822,18 @@ Tcl_RegsubObjCmd(
 			    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) {
@@ -782,10 +844,10 @@ Tcl_RegsubObjCmd(
 	    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);
 		}
@@ -801,49 +863,41 @@ Tcl_RegsubObjCmd(
      * 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) {
 	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
     }
     if (objc == 4) {
-	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
-		TCL_LEAVE_ERR_MSG) == NULL) {
+	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
+	    Tcl_AppendResult(interp, "couldn't set variable \"",
+		    Tcl_GetString(objv[3]), "\"", (char *) 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_SetObjResult(interp, Tcl_NewIntObj(numMatches));
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), 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;
 }
 
@@ -852,8 +906,8 @@ Tcl_RegsubObjCmd(
  *
  * 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.
@@ -864,22 +918,23 @@ Tcl_RegsubObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-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. */
+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. */
 {
-    const char *oldName, *newName;
-
+    char *oldName, *newName;
+    
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
 	return TCL_ERROR;
     }
 
-    oldName = TclGetString(objv[1]);
-    newName = TclGetString(objv[2]);
+    oldName = Tcl_GetString(objv[1]);
+    newName = Tcl_GetString(objv[2]);
     return TclRenameCommand(interp, oldName, newName);
 }
 
@@ -900,34 +955,83 @@ Tcl_RenameObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_ReturnObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    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;
+    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;
+	}
     }
+    
+    if (objc == 1) {
+	/*
+	 * Set the interpreter's object result. An inline version of
+	 * Tcl_SetObjResult.
+	 */
 
-    code = TclProcessReturn(interp, code, level, returnOpts);
-    if (explicitResult) {
-	Tcl_SetObjResult(interp, objv[objc-1]);
+	Tcl_SetObjResult(interp, objv[0]);
     }
-    return code;
+    iPtr->returnCode = code;
+    return TCL_RETURN;
 }
 
 /*
@@ -935,8 +1039,8 @@ Tcl_ReturnObjCmd(
  *
  * 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.
@@ -947,47 +1051,20 @@ Tcl_ReturnObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_SourceObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRSourceObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRSourceObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *encodingName = NULL;
-    Tcl_Obj *fileName;
-
-    if (objc != 2 && objc !=4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
 	return TCL_ERROR;
     }
 
-    fileName = objv[objc-1];
-
-    if (objc == 4) {
-	static const char *const 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 TclNREvalFile(interp, fileName, encodingName);
+    return Tcl_FSEvalFile(interp, objv[1]);
 }
 
 /*
@@ -995,8 +1072,8 @@ TclNRSourceObjCmd(
  *
  * 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.
@@ -1007,18 +1084,17 @@ TclNRSourceObjCmd(
  *----------------------------------------------------------------------
  */
 
+	/* ARGSUSED */
 int
-Tcl_SplitObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_UniChar ch;
     int len;
-    const char *splitChars;
-    const char *stringPtr;
-    const char *end;
+    char *splitChars, *string, *end;
     int splitCharLen, stringLen;
     Tcl_Obj *listPtr, *objPtr;
 
@@ -1026,16 +1102,16 @@ Tcl_SplitObjCmd(
 	splitChars = " \n\t\r";
 	splitCharLen = 4;
     } else if (objc == 3) {
-	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
+	splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen);
     } else {
 	Tcl_WrongNumArgs(interp, 1, objv, "string ?splitChars?");
 	return TCL_ERROR;
     }
 
-    stringPtr = TclGetStringFromObj(objv[1], &stringLen);
-    end = stringPtr + stringLen;
-    listPtr = Tcl_NewObj();
-
+    string = Tcl_GetStringFromObj(objv[1], &stringLen);
+    end = string + stringLen;
+    listPtr = Tcl_GetObjResult(interp);
+    
     if (stringLen == 0) {
 	/*
 	 * Do nothing.
@@ -1048,94 +1124,87 @@ Tcl_SplitObjCmd(
 	/*
 	 * 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 ( ; stringPtr < end; stringPtr += len) {
-	    len = TclUtfToUniChar(stringPtr, &ch);
-
-	    /*
-	     * Assume Tcl_UniChar is an integral type...
-	     */
-
-	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR((int) ch),
-		    &isNew);
+	for ( ; string < end; string += len) {
+	    len = TclUtfToUniChar(string, &ch);
+	    /* Assume Tcl_UniChar is an integral type... */
+	    hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0 + ch, &isNew);
 	    if (isNew) {
-		TclNewStringObj(objPtr, stringPtr, len);
-
-		/*
-		 * Don't need to fiddle with refcount...
-		 */
-
-		Tcl_SetHashValue(hPtr, objPtr);
+		objPtr = Tcl_NewStringObj(string, len);
+		/* Don't need to fiddle with refcount... */
+		Tcl_SetHashValue(hPtr, (ClientData) objPtr);
 	    } else {
-		objPtr = 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 (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) {
-	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
+	while (*string && (p = strchr(string, (int) *splitChars)) != NULL) {
+	    objPtr = Tcl_NewStringObj(string, p - string);
 	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
-	    stringPtr = p + 1;
+	    string = p + 1;
 	}
-	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
+	objPtr = Tcl_NewStringObj(string, end - string);
 	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
     } else {
-	const char *element, *p, *splitEnd;
+	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 = stringPtr; stringPtr < end; stringPtr += len) {
-	    len = TclUtfToUniChar(stringPtr, &ch);
+	for (element = string; string < end; string += len) {
+	    len = TclUtfToUniChar(string, &ch);
 	    for (p = splitChars; p < splitEnd; p += splitLen) {
 		splitLen = TclUtfToUniChar(p, &splitChar);
 		if (ch == splitChar) {
-		    TclNewStringObj(objPtr, element, stringPtr - element);
+		    objPtr = Tcl_NewStringObj(element, string - element);
 		    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
-		    element = stringPtr + len;
+		    element = string + len;
 		    break;
 		}
 	    }
 	}
-
-	TclNewStringObj(objPtr, element, stringPtr - element);
+	objPtr = Tcl_NewStringObj(element, string - element);
 	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
     }
-    Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * StringFirstCmd --
+ * Tcl_StringObjCmd --
  *
- *	This procedure is invoked to process the "string first" 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.
+ *	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').
  *
  * Results:
  *	A standard Tcl result.
@@ -1146,922 +1215,1248 @@ Tcl_SplitObjCmd(
  *----------------------------------------------------------------------
  */
 
-static int
-StringFirstCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+	/* 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. */
 {
-    Tcl_UniChar *needleStr, *haystackStr;
-    int match, start, needleLen, haystackLen;
+    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 < 3 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"needleString haystackString ?startIndex?");
+    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) {
 	return TCL_ERROR;
     }
 
-    /*
-     * We are searching haystackStr for the sequence needleStr.
-     */
-
-    match = -1;
-    start = 0;
-    haystackLen = -1;
-
-    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
-    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
-
-    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 (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
-		&start) != TCL_OK){
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Reread to prevent shimmering problems.
-	 */
-
-	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
-	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
-
-	if (start >= haystackLen) {
-	    goto str_first_done;
-	} else if (start > 0) {
-	    haystackStr += start;
-	    haystackLen -= start;
-	} else if (start < 0) {
+    resultPtr = Tcl_GetObjResult(interp);
+    switch ((enum options) index) {
+	case STR_EQUAL:
+	case STR_COMPARE: {
 	    /*
-	     * Invalid start index mapped to string start; Bug #423581
+	     * 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)();
 
-	    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 (objc < 4 || objc > 7) {
+	    str_cmp_args:
+	        Tcl_WrongNumArgs(interp, 2, objv,
+				 "?-nocase? ?-length int? string1 string2");
+		return TCL_ERROR;
+	    }
 
-    if (needleLen > 0 && needleLen <= haystackLen) {
-	register Tcl_UniChar *p, *end;
+	    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;
+		}
+	    }
 
-	end = haystackStr + haystackLen - needleLen + 1;
-	for (p = haystackStr;  p < end;  p++) {
 	    /*
-	     * Scan forward to find the first character.
+	     * From now on, we only access the two objects at the end
+	     * of the argument array.
 	     */
+	    objv += objc-2;
+
+	    if ((reqlength == 0) || (objv[0] == objv[1])) {
+		/*
+		 * Alway match at 0 chars of if it is the same obj.
+		 */
 
-	    if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p,
-		    (unsigned long) needleLen) == 0)) {
-		match = p - haystackStr;
+		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;
+		}
 	    }
-	}
-    }
-
-    /*
-     * Compute the character index of the matching string by counting the
-     * number of characters before the match.
-     */
-
-    if ((match != -1) && (objc == 4)) {
-	match += start;
-    }
-
-  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. 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
-StringLastCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_UniChar *needleStr, *haystackStr, *p;
-    int match, start, needleLen, haystackLen;
-
-    if (objc < 3 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"needleString haystackString ?startIndex?");
-	return TCL_ERROR;
-    }
 
-    /*
-     * We are searching haystackString for the sequence needleString.
-     */
-
-    match = -1;
-    start = 0;
-    haystackLen = -1;
+	    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;
+		}
+	    }
 
-    needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
-    haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+	    if ((enum options) index == STR_EQUAL) {
+		Tcl_SetBooleanObj(resultPtr, (match) ? 0 : 1);
+	    } else {
+		Tcl_SetIntObj(resultPtr, ((match > 0) ? 1 :
+					  (match < 0) ? -1 : 0));
+	    }
+	    break;
+	}
+	case STR_FIRST: {
+	    Tcl_UniChar *ustring1, *ustring2;
+	    int match, start;
 
-    if (objc == 4) {
-	/*
-	 * If a startIndex is specified, we will need to restrict the string
-	 * range to that char index in the string
-	 */
+	    if (objc < 4 || objc > 5) {
+	        Tcl_WrongNumArgs(interp, 2, objv,
+				 "subString string ?startIndex?");
+		return TCL_ERROR;
+	    }
 
-	if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
-		&start) != TCL_OK){
-	    return TCL_ERROR;
-	}
+	    /*
+	     * We are searching string2 for the sequence string1.
+	     */
 
-	/*
-	 * Reread to prevent shimmering problems.
-	 */
+	    match = -1;
+	    start = 0;
+	    length2 = -1;
 
-	needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
-	haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
+	    ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
+	    ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
 
-	if (start < 0) {
-	    goto str_last_done;
-	} else if (start < haystackLen) {
-	    p = haystackStr + start + 1 - needleLen;
-	} else {
-	    p = haystackStr + haystackLen - needleLen;
-	}
-    } else {
-	p = haystackStr + haystackLen - needleLen;
-    }
+	    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 (needleLen > 0 && needleLen <= haystackLen) {
-	for (; p >= haystackStr; p--) {
+		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;
+		    }
+		}
+	    }
 	    /*
-	     * Scan backwards to find the first character.
+	     * Compute the character index of the matching string by
+	     * counting the number of characters before the match.
 	     */
-
-	    if ((*p == *needleStr) && !memcmp(needleStr, p,
-		    sizeof(Tcl_UniChar) * (size_t)needleLen)) {
-		match = p - haystackStr;
-		break;
+	    if ((match != -1) && (objc == 5)) {
+		match += start;
 	    }
-	}
-    }
-
-  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.
- *
- *----------------------------------------------------------------------
- */
 
-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;
+	    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 (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
-	return TCL_ERROR;
-    }
+	    /*
+	     * 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.
+	     */
 
-    /*
-     * Get the char length to calulate what 'end' means.
-     */
+	    if (objv[2]->typePtr == &tclByteArrayType) {
+		string1 = (char *) Tcl_GetByteArrayFromObj(objv[2], &length1);
 
-    length = Tcl_GetCharLength(objv[1]);
-    if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
+		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]);
 
-    if ((index >= 0) && (index < length)) {
-	Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index);
+		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;
 
-	/*
-	 * If we have a ByteArray object, we're careful to generate a new
-	 * bytearray for a result.
-	 */
+		    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 (TclIsPureByteArray(objv[1])) {
-	    unsigned char uch = (unsigned char) ch;
+            /*
+	     * The UniChar comparison function
+	     */
 
-	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
-	} else {
-	    char buf[TCL_UTF_MAX];
+	    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;
+		    }
+		}
+	    }
 
-	    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.
- *
- *----------------------------------------------------------------------
- */
+	    /*
+	     * 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;
 
-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 *const isClasses[] = {
-	"alnum",	"alpha",	"ascii",	"control",
-	"boolean",	"digit",	"double",	"entier",
-	"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_ENTIER,
-	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 *const isOptions[] = {
-	"-strict", "-failindex", NULL
-    };
-    enum isOptions {
-	OPT_STRICT, OPT_FAILIDX
-    };
+	    /*
+	     * 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 < 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 ((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 (objc != 3) {
-	for (i = 2; i < objc-1; i++) {
-	    int idx2;
+		    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;
 
-	    if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0,
-		    &idx2) != TCL_OK) {
-		return TCL_ERROR;
+		    } 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;
+		}
 	    }
-	    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");
+	    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;
 		}
-		failVarObj = objv[++i];
-		break;
 	    }
+	    Tcl_SetBooleanObj(resultPtr, result);
+	    break;
 	}
-    }
+	case STR_LAST: {
+	    Tcl_UniChar *ustring1, *ustring2, *p;
+	    int match, start;
 
-    /*
-     * 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).
-     */
+	    if (objc < 4 || objc > 5) {
+	        Tcl_WrongNumArgs(interp, 2, objv,
+				 "subString string ?startIndex?");
+		return TCL_ERROR;
+	    }
 
-    objPtr = objv[objc-1];
+	    /*
+	     * We are searching string2 for the sequence string1.
+	     */
 
-    /*
-     * When entering here, result == 1 and failat == 0.
-     */
+	    match = -1;
+	    start = 0;
+	    length2 = -1;
 
-    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;
+	    ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
+	    ustring2 = Tcl_GetUnicodeFromObj(objv[3], &length2);
+
+	    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 {
-		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;
-	}
-	string1 = TclGetStringFromObj(objPtr, &length1);
-	if (length1 == 0) {
-	    if (strict) {
-		result = 0;
+		p = ustring2 + length2 - length1;
 	    }
-	    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);
+
+	    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;
+		    }
+		}
 	    }
-	}
-	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_ENTIER:
-	if ((objPtr->typePtr == &tclIntType) ||
-#ifndef NO_WIDE_TYPE
-		(objPtr->typePtr == &tclWideIntType) ||
-#endif
-		(objPtr->typePtr == &tclBignumType)) {
+
+	    str_last_done:
+	    Tcl_SetIntObj(resultPtr, match);
 	    break;
 	}
-	string1 = TclGetStringFromObj(objPtr, &length1);
-	if (length1 == 0) {
-	    if (strict) {
-		result = 0;
+	case STR_BYTELENGTH:
+	case STR_LENGTH: {
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "string");
+		return TCL_ERROR;
 	    }
-	    goto str_is_done;
-	}
-	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.
-		 */
 
-		break;
+	    if ((enum options) index == STR_BYTELENGTH) {
+		(void) Tcl_GetStringFromObj(objv[2], &length1);
 	    } else {
 		/*
-		 * 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.
+		 * 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.
 		 */
 
-		result = 0;
-		failat = stop - string1;
-		TclFreeIntRep(objPtr);
+		if (objv[2]->typePtr == &tclByteArrayType) {
+		    (void) Tcl_GetByteArrayFromObj(objv[2], &length1);
+		} else {
+		    length1 = Tcl_GetCharLength(objv[2]);
+		}
 	    }
-	} else {
-	    /*
-	     * No prefix is a valid integer. Fail at beginning.
-	     */
-
-	    result = 0;
-	    failat = 0;
-	}
-	break;
-    case STR_IS_WIDE:
-	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
+	    Tcl_SetIntObj(resultPtr, length1);
 	    break;
 	}
+	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;
+	    }
 
-    failedIntParse:
-	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;
-	}
-	result = 0;
-	if (failVarObj == NULL) {
-	    /*
-	     * Don't bother computing the failure point if we're not going to
-	     * return it.
-	     */
 
-	    break;
-	}
-	end = string1 + length1;
-	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
-		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
-	    if (stop == end) {
+	    if (Tcl_ListObjGetElements(interp, objv[objc-2], &mapElemc,
+				       &mapElemv) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    if (mapElemc == 0) {
 		/*
-		 * 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.
+		 * empty charMap, just return whatever string was given
 		 */
-
-		failat = -1;
-	    } else {
+		Tcl_SetObjResult(interp, objv[objc-1]);
+		return TCL_OK;
+	    } else if (mapElemc & 1) {
 		/*
-		 * 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.
+		 * The charMap must be an even number of key/value items
 		 */
-
-		failat = stop - string1;
-		TclFreeIntRep(objPtr);
+		Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
+		return TCL_ERROR;
 	    }
-	} else {
+
 	    /*
-	     * No prefix is a valid integer. Fail at beginning.
+	     * 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
+		 */
+		if (copySource) {
+		    Tcl_DecrRefCount(sourceObj);
+		}
+		break;
+	    }
+	    end = ustring1 + length1;
 
-	    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;
-	}
+	    strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
 
-	if (failVarObj != NULL) {
 	    /*
-	     * Need to figure out where the list parsing failed, which is
-	     * fairly expensive. This is adapted from the core of
-	     * SetListFromAny().
+	     * Force result to be Unicode
 	     */
+	    Tcl_SetUnicodeObj(resultPtr, ustring1, 0);
 
-	    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;
-
-		    /*
-		     * 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.
-		     */
+	    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);
+			}
+		    }
+		}
+	    } 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;
 
-		    while (TclIsSpaceProc(*p)) {
-			p++;
+			    /*
+			     * Append the map value to the unicode string
+			     */
+			    Tcl_AppendUnicodeToObj(resultPtr,
+				    mapStrings[index+1], mapLens[index+1]);
+			    break;
+			}
 		    }
-		    TclNewStringObj(tmpStr, string1, p-string1);
-		    failat = Tcl_GetCharLength(tmpStr);
-		    TclDecrRefCount(tmpStr);
-		    break;
+		}
+		ckfree((char *) mapStrings);
+		ckfree((char *) mapLens);
+		if (nocase) {
+		    ckfree((char *) u2lc);
 		}
 	    }
-	}
-	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;
+	    if (p != ustring1) {
+		/*
+		 * Put the rest of the unmapped chars onto result
+		 */
+		Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
 	    }
-	    goto str_is_done;
-	}
-	end = string1 + length1;
-	for (; string1 < end; string1 += length2, failat++) {
-	    length2 = TclUtfToUniChar(string1, &ch);
-	    if (!chcomp(ch)) {
-		result = 0;
-		break;
+	    if (copySource) {
+		Tcl_DecrRefCount(sourceObj);
 	    }
+	    break;
 	}
-    }
+	case STR_MATCH: {
+	    Tcl_UniChar *ustring1, *ustring2;
+	    int nocase = 0;
 
-    /*
-     * Only set the failVarObj when we will return 0 and we have indicated a
-     * valid fail index (>= 0).
-     */
+	    if (objc < 4 || objc > 5) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? pattern string");
+		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 (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;
+		}
+	    }
+	    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_RANGE: {
+	    int first, last;
 
-static int
-UniCharIsAscii(
-    int character)
-{
-    return (character >= 0) && (character < 0x80);
-}
+	    if (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.
- *
- *----------------------------------------------------------------------
- */
+	    /*
+	     * 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.
+	     */
 
-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 (objv[2]->typePtr == &tclByteArrayType) {
+		string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
+		length1--;
+	    } else {
+		/*
+		 * Get the length in actual characters.
+		 */
+		string1 = NULL;
+		length1 = Tcl_GetCharLength(objv[2]) - 1;
+	    }
 
-    if (objc == 4) {
-	const char *string = TclGetStringFromObj(objv[1], &length2);
+	    if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
+		    || (TclGetIntForIndex(interp, objv[4], length1,
+			    &last) != TCL_OK)) {
+		return TCL_ERROR;
+	    }
 
-	if ((length2 > 1) &&
-		strncmp(string, "-nocase", (size_t) length2) == 0) {
-	    nocase = 1;
-	} else {
-	    Tcl_AppendResult(interp, "bad option \"", string,
-		    "\": must be -nocase", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
-		    string, NULL);
-	    return TCL_ERROR;
+	    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));
+		}
+	    }
+	    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!)
-     */
-
-    if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
-	int i, done;
-	Tcl_DictSearch search;
+	case STR_REPEAT: {
+	    int count;
 
-	/*
-	 * We know the type exactly, so all dict operations will succeed for
-	 * sure. This shortens this code quite a bit.
-	 */
+	    if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 2, objv, "string count");
+		return TCL_ERROR;
+	    }
 
-	Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
-	if (mapElemc == 0) {
-	    /*
-	     * Empty charMap, just return whatever string was given.
-	     */
+	    if (Tcl_GetIntFromObj(interp, objv[3], &count) != TCL_OK) {
+		return TCL_ERROR;
+	    }
 
-	    Tcl_SetObjResult(interp, objv[objc-1]);
-	    return TCL_OK;
+	    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
+		     */
+		    string2		= (char *) ckalloc((size_t) length2+1);
+		    for (index = 0; index < count; index++) {
+			memcpy(string2 + (length1 * index), string1,
+				(size_t) length1);
+		    }
+		    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);
+		}
+	    }
+	    break;
 	}
+	case STR_REPLACE: {
+	    Tcl_UniChar *ustring1;
+	    int first, last;
 
-	mapElemc *= 2;
-	mapWithDict = 1;
+	    if (objc < 5 || objc > 6) {
+	        Tcl_WrongNumArgs(interp, 2, objv,
+				 "string first last ?string?");
+		return TCL_ERROR;
+	    }
 
-	/*
-	 * Copy the dictionary out into an array; that's the easiest way to
-	 * adapt this code...
-	 */
+	    ustring1 = Tcl_GetUnicodeFromObj(objv[2], &length1);
+	    length1--;
 
-	mapElemv = 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);
-	}
-	Tcl_DictObjDone(&search);
-    } else {
-	if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
-		&mapElemv) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (mapElemc == 0) {
-	    /*
-	     * empty charMap, just return whatever string was given.
-	     */
+	    if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
+		    || (TclGetIntForIndex(interp, objv[4], length1,
+			    &last) != TCL_OK)) {
+		return TCL_ERROR;
+	    }
 
-	    Tcl_SetObjResult(interp, objv[objc-1]);
-	    return TCL_OK;
-	} else if (mapElemc & 1) {
-	    /*
-	     * The charMap must be an even number of key/value items.
-	     */
+	    if ((last < first) || (last < 0) || (first > length1)) {
+		Tcl_SetObjResult(interp, objv[2]);
+	    } else {
+		if (first < 0) {
+		    first = 0;
+		}
 
-	    Tcl_SetObjResult(interp,
-		    Tcl_NewStringObj("char map list unbalanced", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
-		    "UNBALANCED", NULL);
-	    return TCL_ERROR;
+		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;
+	    }
 
-    /*
-     * 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]
-     */
+	    string1 = Tcl_GetStringFromObj(objv[2], &length1);
 
-    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;
+	    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.
+		 */
 
-    strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
+		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;
 
-    /*
-     * Force result to be Unicode
-     */
+		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;
 
-    resultPtr = Tcl_NewUnicodeObj(ustring1, 0);
+	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 (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.
-	 */
+	    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.
+		 */
 
-	int mapLen;
-	Tcl_UniChar *mapString, u2lc;
+		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;
 
-	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
-	p = ustring1;
-	if ((length2 > length1) || (length2 == 0)) {
-	    /*
-	     * Match string is either longer than input or empty.
-	     */
+		/*
+		 * 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.
+		 */
 
-	    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;
+		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;
+			}
 		    }
-		    ustring1 = p - 1;
-
-		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
 		}
 	    }
+	    Tcl_SetStringObj(resultPtr, string1, length1);
+	    break;
 	}
-    } 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 = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
-	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
-	if (nocase) {
-	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
+	case STR_TRIMLEFT: {
+	    left = 1;
+	    right = 0;
+	    goto dotrim;
 	}
-	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]);
-	    }
+	case STR_TRIMRIGHT: {
+	    left = 0;
+	    right = 1;
+	    goto dotrim;
 	}
-	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.
-			 */
+	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;
+	    }
 
-			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
-			p = ustring1 + length2;
-		    } else {
-			p += length2;
+	    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;
 		    }
-
-		    /*
-		     * 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;
 		}
+		if (cur == index) {
+		    cur++;
+		}
+	    } else {
+		cur = numChars;
 	    }
+	    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.
-	 */
+	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;
+	    }
 
-	Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
-    }
-    Tcl_SetObjResult(interp, resultPtr);
-  done:
-    if (mapWithDict) {
-	TclStackFree(interp, mapElemv);
-    }
-    if (copySource) {
-	Tcl_DecrRefCount(sourceObj);
+	    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;
+	    }
+	    cur = 0;
+	    if (index > 0) {
+		p = Tcl_UtfAtIndex(string1, index);
+	        for (cur = index; cur >= 0; cur--) {
+		    TclUtfToUniChar(p, &ch);
+		    if (!Tcl_UniCharIsWordChar(ch)) {
+			break;
+		    }
+		    p = Tcl_UtfPrev(p, string1);
+		}
+		if (cur != index) {
+		    cur += 1;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, cur);
+	    break;
+	}
     }
     return TCL_OK;
 }
@@ -2069,11 +2464,11 @@ StringMapCmd(
 /*
  *----------------------------------------------------------------------
  *
- * StringMatchCmd --
+ * Tcl_SubstObjCmd --
  *
- *	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.
+ *	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:
  *	A standard Tcl result.
@@ -2084,51 +2479,94 @@ StringMapCmd(
  *----------------------------------------------------------------------
  */
 
-static int
-StringMatchCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+	/* 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. */
 {
-    int nocase = 0;
+    static CONST char *substOptions[] = {
+	"-nobackslashes", "-nocommands", "-novariables", (char *) NULL
+    };
+    enum substOptions {
+	SUBST_NOBACKSLASHES,      SUBST_NOCOMMANDS,       SUBST_NOVARS
+    };
+    Tcl_Obj *resultPtr;
+    int optionIndex, flags, i;
 
-    if (objc < 3 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
-	return TCL_ERROR;
-    }
+    /*
+     * Parse command-line options.
+     */
 
-    if (objc == 4) {
-	int length;
-	const char *string = TclGetStringFromObj(objv[1], &length);
+    flags = TCL_SUBST_ALL;
+    for (i = 1; i < (objc-1); i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], substOptions,
+		"switch", 0, &optionIndex) != TCL_OK) {
 
-	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);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
-		    string, NULL);
 	    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");
+	return TCL_ERROR;
     }
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
+
+    /*
+     * Perform the substitution.
+     */
+    resultPtr = Tcl_SubstObj(interp, objv[i], flags);
+
+    if (resultPtr == NULL) {
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * 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.
+ * 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...
  *
  * Results:
- *	A standard Tcl result.
+ *	A Tcl_Obj* containing the substituted string, or NULL to
+ *	indicate that an error occurred.
  *
  * Side effects:
  *	See the user documentation.
@@ -2136,55 +2574,144 @@ StringMatchCmd(
  *----------------------------------------------------------------------
  */
 
-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 *
+Tcl_SubstObj(interp, objPtr, flags)
+    Tcl_Interp *interp;
+    Tcl_Obj *objPtr;
+    int flags;
 {
-    int length, first, last;
+    Tcl_Obj *resultObj;
+    char *p, *old;
+    int length;
 
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string first last");
-	return TCL_ERROR;
-    }
+    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;
 
-    /*
-     * Get the length in actual characters; Then reduce it by one because
-     * 'end' refers to the last character, not one past it.
-     */
+	case '$':
+	    if (flags & TCL_SUBST_VARIABLES) {
+		Tcl_Parse parse;
+		int code;
 
-    length = Tcl_GetCharLength(objv[1]) - 1;
+		/*
+		 * 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 (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
-	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
-	return TCL_ERROR;
-    }
+	case '[':
+	    if (flags & TCL_SUBST_COMMANDS) {
+		Interp *iPtr = (Interp *) interp;
+		int code;
 
-    if (first < 0) {
-	first = 0;
-    }
-    if (last >= length) {
-	last = length;
+		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 (last >= first) {
-	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
+    if (p != old) {
+	Tcl_AppendToObj(resultObj, old, p-old);
     }
-    return TCL_OK;
+    return resultObj;
+
+ errorResult:
+    Tcl_DecrRefCount(resultObj);
+    return NULL;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * StringReptCmd --
+ * Tcl_SwitchObjCmd --
  *
- *	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.
+ *	This object-based procedure is invoked to process the "switch" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -2192,273 +2719,277 @@ StringRangeCmd(
  *----------------------------------------------------------------------
  */
 
-static int
-StringReptCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+	/* 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. */
 {
-    const char *string1;
-    char *string2;
-    int count, index, length1, length2;
-    Tcl_Obj *resultPtr;
+    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
+    };
 
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string count");
-	return TCL_ERROR;
+    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 (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) {
+    if (objc - i < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?switches? string pattern body ... ?default body?");
 	return TCL_ERROR;
     }
 
-    /*
-     * Check for cases that allow us to skip copying stuff.
-     */
-
-    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;
-    }
+    stringObj = objv[i];
+    objc -= i + 1;
+    objv += i + 1;
+#ifdef TCL_TIP280
+    bidx = i+1; /* First after the match string */
+#endif
 
     /*
-     * 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.
+     * If all of the pattern/command pairs are lumped into a single
+     * argument, split them out again.
      *
-     * 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.
+     * 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.
      */
 
-    if (count > INT_MAX/length1) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"result exceeds max size for a Tcl value (%d bytes)",
-		INT_MAX));
-	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	return TCL_ERROR;
-    }
-    length2 = length1 * count;
-
-    /*
-     * Include space for the NUL.
-     */
+    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;
+	}
 
-    string2 = attemptckalloc((unsigned) length2 + 1);
-    if (string2 == NULL) {
 	/*
-	 * 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).
+	 * Ensure that the list is non-empty.
 	 */
 
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"string size overflow, out of memory allocating %u bytes",
-		length2 + 1));
-	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	return TCL_ERROR;
-    }
-    for (index = 0; index < count; index++) {
-	memcpy(string2 + (length1 * index), string1, (size_t) length1);
+	if (objc < 1) {
+	    Tcl_WrongNumArgs(interp, 1, savedObjv,
+		    "?switches? string {pattern body ... ?default body?}");
+	    return TCL_ERROR;
+	}
+	objv = listv;
+	splitObjs = 1;
     }
-    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.
+     * Complain if there is an odd number of words in the list of
+     * patterns and bodies.
      */
 
-    TclNewObj(resultPtr);
-    resultPtr->bytes = string2;
-    resultPtr->length = length2;
-    Tcl_SetObjResult(interp, resultPtr);
+    if (objc % 2) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
 
-  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.
- *
- *----------------------------------------------------------------------
- */
+	/*
+	 * 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 '#'.
+	 */
 
-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) {
+	    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;
+		}
+	    }
+	}
 
-    if (objc < 4 || objc > 5) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
 	return TCL_ERROR;
     }
 
-    ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
-    length--;
+    /*
+     * Complain if the last body is a continuation.  Note that this
+     * check assumes that the list is non-empty!
+     */
 
-    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
-	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
+    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;
     }
 
-    if ((last < first) || (last < 0) || (first > length)) {
-	Tcl_SetObjResult(interp, objv[1]);
-    } else {
-	Tcl_Obj *resultPtr;
-
-	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
-	length--;
+    for (i = 0; i < objc; i += 2) {
+	/*
+	 * See if the pattern matches the string.
+	 */
 
-	if (first < 0) {
-	    first = 0;
-	}
+	pattern = Tcl_GetString(objv[i]);
 
-	resultPtr = Tcl_NewUnicodeObj(ustring, first);
-	if (objc == 5) {
-	    Tcl_AppendObjToObj(resultPtr, objv[4]);
+	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 (last < length) {
-	    Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
-		    length - last);
+	if (matched == 0) {
+	    continue;
 	}
-	Tcl_SetObjResult(interp, resultPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringRevCmd --
- *
- *	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 result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
 
-static int
-StringRevCmd(
-    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, "string");
-	return TCL_ERROR;
-    }
+	/*
+	 * 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.
+	 */
 
-    Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
+#ifdef TCL_TIP280
+	ctx = *iPtr->cmdFramePtr;
 
-static int
-StringStartCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_UniChar ch;
-    const char *p, *string;
-    int cur, index, length, numChars;
+	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 != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string index");
-	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 */
+	    }
 
-    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 >= 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)) {
+	    if (ctx.type == TCL_LOCATION_SOURCE) {
+		int bline = ctx.line [bidx];
+		if (bline >= 0) {
+		    ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		    ctx.nline = objc;
+
+		    ListLines (blist, bline, objc, ctx.line, objv);
+		} else {
+		    int k;
+		    /* Dynamic code word ... All elements are relative to themselves */
+
+		    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 ... */
+
+		ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		ctx.nline = objc;
+		for (k=0; k < objc; k++) {ctx.line[k] = -1;}
+	    }
+	}
+#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;
 	    }
-	    p = Tcl_UtfPrev(p, string);
 	}
-	if (cur != index) {
-	    cur += 1;
+#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);
+	}
+	return result;
     }
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * StringEndCmd --
+ * Tcl_TimeObjCmd --
  *
- *	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.
+ *	This object-based procedure is invoked to process the "time" Tcl
+ *	command.  See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result.
  *
  * Side effects:
  *	See the user documentation.
@@ -2466,2201 +2997,1936 @@ StringStartCmd(
  *----------------------------------------------------------------------
  */
 
-static int
-StringEndCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+	/* 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. */
 {
-    Tcl_UniChar ch;
-    const char *p, *end, *string;
-    int cur, index, length, numChars;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string index");
-	return TCL_ERROR;
-    }
+    register Tcl_Obj *objPtr;
+    Tcl_Obj *objs[4];
+    register int i, result;
+    int count;
+    double totalMicroSec;
+    Tcl_Time start, stop;
 
-    string = TclGetStringFromObj(objv[1], &length);
-    numChars = Tcl_NumUtfChars(string, length);
-    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
+    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?");
 	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;
-	    }
-	}
-	if (cur == index) {
-	    cur++;
+    
+    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 {
-	cur = numChars;
+	objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
     }
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
+    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));
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * StringEqualCmd --
+ * 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
  *
- *	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:
  *	A standard Tcl result.
  *
  * Side effects:
  *	See the user documentation.
- *
  *----------------------------------------------------------------------
  */
 
-static int
-StringEqualCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+	/* 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. */
 {
-    /*
-     * 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/...).
-     */
-
-    const 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;
+    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
+    };
 
-    if (objc < 3 || objc > 6) {
-    str_cmp_args:
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-nocase? ?-length int? string1 string2");
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
 	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 (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
+		"option", 0, &optionIndex) != 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;
 	    }
-	    i++;
-	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
+	    if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions,
+			"option", 0, &typeIndex) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	} else {
-	    Tcl_AppendResult(interp, "bad option \"", string2,
-		    "\": must be -nocase or -length", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
-		    string2, NULL);
-	    return TCL_ERROR;
+	    return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
 	}
-    }
-
-    /*
-     * From now on, we only access the two objects at the end of the argument
-     * array.
-     */
-
-    objv += objc-2;
-
-    if ((reqlength == 0) || (objv[0] == objv[1])) {
-	/*
-	 * Always match at 0 chars of if it is the same obj.
-	 */
-
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
-	return TCL_OK;
-    }
-
-    if (!nocase && TclIsPureByteArray(objv[0]) &&
-	    TclIsPureByteArray(objv[1])) {
-	/*
-	 * 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.
-	 */
+#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;
+	    }
 
-	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);
+	    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);
+	    }
+	    Tcl_DecrRefCount(opsList);
+	    return code;
 	}
-    }
+	case TRACE_OLD_VINFO: {
+	    ClientData clientData;
+	    char ops[5];
+	    Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;
 
-    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.
-	     */
+	    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';
 
-	    reqlength = length + 1;
-	}
+		/*
+		 * 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.
+		 */
 
-	match = strCmpFn(string1, string2, (unsigned) length);
-	if ((match == 0) && (reqlength > length)) {
-	    match = length1 - length2;
+		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 */
     }
-
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
     return TCL_OK;
+
+    badVarOps:
+    Tcl_AppendResult(interp, "bad operations \"", flagOps,
+	    "\": should be one or more of rwua", (char *) NULL);
+    return TCL_ERROR;
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * StringCmpCmd --
+ * TclTraceExecutionObjCmd --
  *
- *	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.
+ *	Helper function for Tcl_TraceObjCmd; implements the
+ *	[trace {add|remove|info} execution ...] subcommands.
+ *	See the user documentation for details on what these do.
  *
  * Results:
- *	A standard Tcl result.
+ *	Standard Tcl result.
  *
  * Side effects:
- *	See the user documentation.
+ *	Depends on the operation (add, remove, or info) being performed;
+ *	may add or remove command traces on a command.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-StringCmpCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    /*
-     * 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/...).
-     */
-
-    const 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;
-    }
+    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.
+	     */
 
-    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;
+	    result = Tcl_ListObjGetElements(interp, objv[4], &listLen,
+		    &elemPtrs);
+	    if (result != TCL_OK) {
+		return result;
 	    }
-	    i++;
-	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
+	    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;
 	    }
-	} else {
-	    Tcl_AppendResult(interp, "bad option \"", string2,
-		    "\": must be -nocase or -length", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
-		    string2, NULL);
-	    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;
 	}
-    }
-
-    /*
-     * From now on, we only access the two objects at the end of the argument
-     * array.
-     */
-
-    objv += objc-2;
-
-    if ((reqlength == 0) || (objv[0] == objv[1])) {
-	/*
-	 * Always match at 0 chars of if it is the same obj.
-	 */
-
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
-	return TCL_OK;
-    }
+	case TRACE_INFO: {
+	    ClientData clientData;
+	    Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+	    if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 3, objv, "name");
+		return TCL_ERROR;
+	    }
 
-    if (!nocase && TclIsPureByteArray(objv[0]) &&
-	    TclIsPureByteArray(objv[1])) {
-	/*
-	 * 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... :^)
-	 */
+	    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;
 
-	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.
-	 */
+		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
 
-	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.
-	 */
+		/*
+		 * 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.
+		 */
 
-	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);
+		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);
+	    }
+	    Tcl_SetObjResult(interp, resultListPtr);
+	    break;
 	}
     }
-
-    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;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * StringLenCmd --
- *
- *	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:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
 
-static int
-StringLenCmd(
-    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, "string");
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1])));
-    return TCL_OK;
-}
 
 /*
  *----------------------------------------------------------------------
  *
- * StringLowerCmd --
+ * TclTraceCommandObjCmd --
  *
- *	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.
+ *	Helper function for Tcl_TraceObjCmd; implements the
+ *	[trace {add|info|remove} command ...] subcommands.
+ *	See the user documentation for details on what these do.
  *
  * Results:
- *	A standard Tcl result.
+ *	Standard Tcl result.
  *
  * Side effects:
- *	See the user documentation.
+ *	Depends on the operation (add, remove, or info) being performed;
+ *	may add or remove command traces on a command.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-StringLowerCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    int length1, length2;
-    const char *string1;
-    char *string2;
-
-    if (objc < 2 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
-	return TCL_ERROR;
-    }
-
-    string1 = TclGetStringFromObj(objv[1], &length1);
-
-    if (objc == 2) {
-	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
-
-	length1 = Tcl_UtfToLower(TclGetString(resultPtr));
-	Tcl_SetObjLength(resultPtr, length1);
-	Tcl_SetObjResult(interp, resultPtr);
-    } else {
-	int first, last;
-	const char *start, *end;
-	Tcl_Obj *resultPtr;
-
-	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;
+    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.
+	     */
 
-	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
-		&last) != TCL_OK)) {
-	    return TCL_ERROR;
+	    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;
+			tcmdPtr->refCount--;
+			if (tcmdPtr->refCount < 0) {
+			    Tcl_Panic("TclTraceCommandObjCmd: 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;
+	    }
 
-	if (last >= length1) {
-	    last = length1;
-	}
-	if (last < first) {
-	    Tcl_SetObjResult(interp, objv[1]);
-	    return TCL_OK;
-	}
+	    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;
 
-	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);
+		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
 
-	length2 = Tcl_UtfToLower(string2);
-	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
+		/*
+		 * 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.
+		 */
 
-	Tcl_AppendToObj(resultPtr, end, -1);
-	Tcl_SetObjResult(interp, resultPtr);
+		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;
+	}
     }
-
     return TCL_OK;
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * StringUpperCmd --
+ * TclTraceVariableObjCmd --
  *
- *	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.
+ *	Helper function for Tcl_TraceObjCmd; implements the
+ *	[trace {add|info|remove} variable ...] subcommands.
+ *	See the user documentation for details on what these do.
  *
  * Results:
- *	A standard Tcl result.
+ *	Standard Tcl result.
  *
  * Side effects:
- *	See the user documentation.
+ *	Depends on the operation (add, remove, or info) being performed;
+ *	may add or remove variable traces on a variable.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-StringUpperCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    int length1, length2;
-    const char *string1;
-    char *string2;
-
-    if (objc < 2 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
-	return TCL_ERROR;
-    }
-
-    string1 = TclGetStringFromObj(objv[1], &length1);
-
-    if (objc == 2) {
-	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
+    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.
+	     */
 
-	length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
-	Tcl_SetObjLength(resultPtr, length1);
-	Tcl_SetObjResult(interp, resultPtr);
-    } else {
-	int first, last;
-	const char *start, *end;
-	Tcl_Obj *resultPtr;
+	    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]
+		 */
 
-	length1 = Tcl_NumUtfChars(string1, length1) - 1;
-	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (first < 0) {
-	    first = 0;
+		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;
+		    }
+		}
+	    }
+	    break;
 	}
-	last = first;
+	case TRACE_INFO: {
+	    ClientData clientData;
+	    Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;
+	    if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 3, objv, "name");
+		return TCL_ERROR;
+	    }
 
-	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
-		&last) != TCL_OK)) {
-	    return TCL_ERROR;
-	}
+	    resultListPtr = Tcl_GetObjResult(interp);
+	    clientData = 0;
+	    name = Tcl_GetString(objv[3]);
+	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
+		    TraceVarProc, clientData)) != 0) {
 
-	if (last >= length1) {
-	    last = length1;
-	}
-	if (last < first) {
-	    Tcl_SetObjResult(interp, objv[1]);
-	    return TCL_OK;
-	}
+		TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
 
-	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);
+		/*
+		 * 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.
+		 */
 
-	length2 = Tcl_UtfToUpper(string2);
-	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
+		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_AppendToObj(resultPtr, end, -1);
-	Tcl_SetObjResult(interp, resultPtr);
+		elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
+		Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
+		Tcl_ListObjAppendElement(interp, resultListPtr,
+			eachTraceObjPtr);
+	    }
+	    Tcl_SetObjResult(interp, resultListPtr);
+	    break;
+	}
     }
-
     return TCL_OK;
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * StringTitleCmd --
+ * Tcl_CommandTraceInfo --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	A standard Tcl result.
+ *	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.
  *
  * Side effects:
- *	See the user documentation.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-StringTitleCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    int length1, length2;
-    const char *string1;
-    char *string2;
+    Command *cmdPtr;
+    register CommandTrace *tracePtr;
 
-    if (objc < 2 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
-	return TCL_ERROR;
+    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName, 
+		NULL, TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
+	return NULL;
     }
 
-    string1 = TclGetStringFromObj(objv[1], &length1);
-
-    if (objc == 2) {
-	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);
-
-	length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
-	Tcl_SetObjLength(resultPtr, length1);
-	Tcl_SetObjResult(interp, resultPtr);
-    } else {
-	int first, last;
-	const char *start, *end;
-	Tcl_Obj *resultPtr;
-
-	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;
-	}
+    /*
+     * Find the relevant trace, if any, and return its clientData.
+     */
 
-	if (last >= length1) {
-	    last = length1;
+    tracePtr = cmdPtr->tracePtr;
+    if (prevClientData != NULL) {
+	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	    if ((tracePtr->clientData == prevClientData)
+		    && (tracePtr->traceProc == proc)) {
+		tracePtr = tracePtr->nextPtr;
+		break;
+	    }
 	}
-	if (last < first) {
-	    Tcl_SetObjResult(interp, objv[1]);
-	    return TCL_OK;
+    }
+    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	if (tracePtr->traceProc == proc) {
+	    return tracePtr->clientData;
 	}
-
-	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_UtfToTitle(string2);
-	Tcl_SetObjLength(resultPtr, length2 + (start - string1));
-
-	Tcl_AppendToObj(resultPtr, end, -1);
-	Tcl_SetObjResult(interp, resultPtr);
     }
-
-    return TCL_OK;
+    return NULL;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * StringTrimCmd --
+ * Tcl_TraceCommand --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl return value.
  *
  * Side effects:
- *	See the user documentation.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-StringTrimCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *string1, *string2;
-    int triml, trimr, length1, length2;
-
-    if (objc == 3) {
-	string2 = TclGetStringFromObj(objv[2], &length2);
-    } else if (objc == 2) {
-	string2 = DEFAULT_TRIM_SET;
-	length2 = strlen(DEFAULT_TRIM_SET);
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
-	return TCL_ERROR;
-    }
-    string1 = TclGetStringFromObj(objv[1], &length1);
+    Command *cmdPtr;
+    register CommandTrace *tracePtr;
 
-    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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringTrimLCmd --
- *
- *	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:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-StringTrimLCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *string1, *string2;
-    int trim, length1, length2;
-
-    if (objc == 3) {
-	string2 = TclGetStringFromObj(objv[2], &length2);
-    } else if (objc == 2) {
-	string2 = DEFAULT_TRIM_SET;
-	length2 = strlen(DEFAULT_TRIM_SET);
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
+    cmdPtr = (Command*)Tcl_FindCommand(interp, cmdName,
+	    NULL, TCL_LEAVE_ERR_MSG);
+    if (cmdPtr == NULL) {
 	return TCL_ERROR;
     }
-    string1 = TclGetStringFromObj(objv[1], &length1);
 
-    trim = TclTrimLeft(string1, length1, string2, length2);
+    /*
+     * Set up trace information.
+     */
 
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1+trim, length1-trim));
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringTrimRCmd --
- *
- *	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:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
+    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;
 
-static int
-StringTrimRCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *string1, *string2;
-    int trim, length1, length2;
-
-    if (objc == 3) {
-	string2 = TclGetStringFromObj(objv[2], &length2);
-    } else if (objc == 2) {
-	string2 = DEFAULT_TRIM_SET;
-	length2 = strlen(DEFAULT_TRIM_SET);
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
-	return TCL_ERROR;
-    }
-    string1 = TclGetStringFromObj(objv[1], &length1);
-
-    trim = TclTrimRight(string1, length1, string2, length2);
+	/*
+	 * Bug 3484621: New execution trace means we no longer compile
+	 * this command if we normally would.  Invalidate bytecode.
+	 */
 
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
+	if (cmdPtr->compileProc != NULL) {
+	    ((Interp *)interp)->compileEpoch++;
+	}
+    }
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclInitStringCmd --
+ * Tcl_UntraceCommand --
  *
- *	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').
+ *	Remove a previously-created trace for a command.
  *
  * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-TclInitStringCmd(
-    Tcl_Interp *interp)		/* Current interpreter. */
-{
-    static const EnsembleImplMap stringImplMap[] = {
-	{"bytelength",	StringBytesCmd,	NULL, NULL, NULL, 0},
-	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
-	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
-	{"first",	StringFirstCmd,	NULL, NULL, NULL, 0},
-	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
-	{"is",		StringIsCmd,	NULL, NULL, NULL, 0},
-	{"last",	StringLastCmd,	NULL, NULL, NULL, 0},
-	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
-	{"map",		StringMapCmd,	NULL, NULL, NULL, 0},
-	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
-	{"range",	StringRangeCmd,	NULL, NULL, NULL, 0},
-	{"repeat",	StringReptCmd,	NULL, NULL, NULL, 0},
-	{"replace",	StringRplcCmd,	NULL, NULL, NULL, 0},
-	{"reverse",	StringRevCmd,	NULL, NULL, NULL, 0},
-	{"tolower",	StringLowerCmd,	NULL, NULL, NULL, 0},
-	{"toupper",	StringUpperCmd,	NULL, NULL, NULL, 0},
-	{"totitle",	StringTitleCmd,	NULL, NULL, NULL, 0},
-	{"trim",	StringTrimCmd,	NULL, NULL, NULL, 0},
-	{"trimleft",	StringTrimLCmd,	NULL, NULL, NULL, 0},
-	{"trimright",	StringTrimRCmd,	NULL, NULL, NULL, 0},
-	{"wordend",	StringEndCmd,	NULL, NULL, NULL, 0},
-	{"wordstart",	StringStartCmd,	NULL, NULL, NULL, 0},
-	{NULL, NULL, NULL, NULL, NULL, 0}
-    };
-
-    return TclMakeEnsemble(interp, "string", stringImplMap);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SubstObjCmd --
- *
- *	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:
- *	A standard Tcl result.
+ *	None.
  *
  * Side effects:
- *	See the user documentation.
+ *	If there exists a trace for the command given by cmdName
+ *	with the given flags, proc, and clientData, then that trace
+ *	is removed.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclSubstOptions(
-    Tcl_Interp *interp,
-    int numOpts,
-    Tcl_Obj *const opts[],
-    int *flagPtr)
+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 const char *const substOptions[] = {
-	"-nobackslashes", "-nocommands", "-novariables", NULL
-    };
-    enum {
-	SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
-    };
-    int i, flags = TCL_SUBST_ALL;
+    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;
+    }
 
-    for (i = 0; i < numOpts; i++) {
-	int optionIndex;
+    flags &= (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
 
-	if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0,
-		&optionIndex) != TCL_OK) {
-	    return TCL_ERROR;
+    for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL;  ;
+	 prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
+	if (tracePtr == NULL) {
+	    return;
 	}
-	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;
+	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;
-	default:
-	    Tcl_Panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
 	}
     }
-    *flagPtr = flags;
-    return TCL_OK;
-}
-
-int
-Tcl_SubstObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRSubstObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRSubstObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    int 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 CallCommandTraces.
+     */
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-nobackslashes? ?-nocommands? ?-novariables? string");
-	return TCL_ERROR;
+    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;
 
-    if (TclSubstOptions(interp, objc-2, objv+1, &flags) != TCL_OK) {
-	return TCL_ERROR;
+	/*
+	 * Bug 3484621: No more execution trace means we can compile
+	 * the command again.  If we will, invalidate bytecode.
+	 */
+
+	if (cmdPtr->compileProc != NULL) {
+	    ((Interp *)interp)->compileEpoch++;
+	}
     }
-    return Tcl_NRSubstObj(interp, objv[objc-1], flags);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SwitchObjCmd --
+ * TraceCommandProc --
  *
- *	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 called to handle command changes that have
+ *	been traced using the "trace" command, when using the 
+ *	'rename' or 'delete' options.
  *
  * Results:
- *	A standard Tcl object result.
+ *	None.
  *
  * Side effects:
- *	See the user documentation.
+ *	Depends on the command associated with the trace.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_SwitchObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRSwitchObjCmd, dummy, objc, objv);
-}
-int
-TclNRSwitchObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+	/* 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. */
 {
-    int i,j, index, mode, foundmode, splitObjs, numMatchesSaved;
-    int noCase, patternLength;
-    const char *pattern;
-    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
-    Tcl_Obj *const *savedObjv = objv;
-    Tcl_RegExp regExpr = NULL;
     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 *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 *const 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);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
-			"DOUBLEOPT", NULL);
-		return TCL_ERROR;
-	    }
-	    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);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
-			"NOVAR", 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);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
-			"NOVAR", NULL);
-		return TCL_ERROR;
-	    }
-	    matchVarObj = objv[i];
-	    numMatchesSaved = -1;
-	    break;
-	}
-    }
-
-  finishedOptions:
-    if (objc - i < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?-switch ...? string ?pattern body ...? ?default body?");
-	return TCL_ERROR;
-    }
-    if (indexVarObj != NULL && mode != OPT_REGEXP) {
-	Tcl_AppendResult(interp,
-		"-indexvar option requires -regexp option", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
-		"MODERESTRICTION", NULL);
-	return TCL_ERROR;
-    }
-    if (matchVarObj != NULL && mode != OPT_REGEXP) {
-	Tcl_AppendResult(interp,
-		"-matchvar option requires -regexp option", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
-		"MODERESTRICTION", NULL);
-	return TCL_ERROR;
-    }
-
-    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;
-	}
-
+    int stateCode;
+    Tcl_SavedResult state;
+    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
+    int code;
+    Tcl_DString cmd;
+    
+    tcmdPtr->refCount++;
+    
+    if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)) {
 	/*
-	 * Ensure that the list is non-empty.
+	 * Generate a command to execute by appending list elements
+	 * for the old and new command name and the operation.
 	 */
 
-	if (objc < 1) {
-	    Tcl_WrongNumArgs(interp, 1, savedObjv,
-		    "?-switch ...? string {?pattern body ...? ?default body?}");
-	    return TCL_ERROR;
+	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);
 	}
-	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);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
-		NULL);
 
 	/*
-	 * Check if this can be due to a badly placed comment in the switch
-	 * block.
+	 * 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.
 	 *
-	 * The following is an heuristic to detect the infamous "comment in
-	 * switch" error: just check if a pattern begins with '#'.
+	 * 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 (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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
-			    "BADARM", "COMMENT?", NULL);
-		    break;
-		}
-	    }
+	Tcl_SaveResult(interp, &state);
+	stateCode = iPtr->returnCode;
+	if (flags & TCL_TRACE_DESTROYED) {
+	    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
 	}
 
-	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);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
-		"FALLTHROUGH", NULL);
-	return TCL_ERROR;
-    }
-
-    for (i = 0; i < objc; i += 2) {
-	/*
-	 * See if the pattern matches the string.
-	 */
-
-	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;
+	code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
+		Tcl_DStringLength(&cmd), 0);
+	if (code != TCL_OK) {	     
+	    /* We ignore errors in these traced commands */
 	}
 
-	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 {
-		int matched = Tcl_RegExpExecObj(interp, regExpr, stringObj, 0,
-			numMatchesSaved, 0);
-
-		if (matched < 0) {
-		    return TCL_ERROR;
-		} else if (matched) {
-		    goto matchFoundRegexp;
-		}
-	    }
-	    break;
-	}
+	Tcl_RestoreResult(interp, &state);
+	iPtr->returnCode = stateCode;
+	
+	Tcl_DStringFree(&cmd);
     }
-    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]
+     * 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 (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];
-
-		rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
-		rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end);
-
-		/*
-		 * Never fails; the object is always clean at this point.
-		 */
-
-		Tcl_ListObjAppendElement(NULL, indicesObj,
-			Tcl_NewListObj(2, rangeObjAry));
-	    }
-
-	    if (matchVarObj != NULL) {
-		Tcl_Obj *substringObj;
-
-		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 (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);
 	    }
 	}
-
-	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 (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
+	    /* Postpone deletion, until exec trace returns */
+	    tcmdPtr->flags = 0;
 	}
-	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.
-		 */
-
-		return TCL_ERROR;
-	    }
-	}
-    }
-
-    /*
-     * We've got a match. Find a body to execute, skipping bodies that are
-     * "-".
-     */
-
-  matchFound:
-    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-    *ctxPtr = *iPtr->cmdFramePtr;
 
-    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
+	 * 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 (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 (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
-	    int bline = ctxPtr->line[bidx];
-
-	    ctxPtr->line = 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 = ckalloc(objc * sizeof(int));
-	    ctxPtr->nline = objc;
-	    for (k=0; k < objc; k++) {
-		ctxPtr->line[k] = -1;
+	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;
 	}
-    }
 
-    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 (strcmp(TclGetString(objv[j]), "-") != 0) {
-	    break;
-	}
-    }
-
-    /*
-     * TIP #280: Make invoking context available to switch branch.
-     */
-
-    Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr,
-	    INT2PTR(pc), (ClientData) pattern);
-    return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
-}
-
-static int
-SwitchPostProc(
-    ClientData data[],		/* Data passed from Tcl_NRAddCallback above */
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    int result)			/* Result to return*/
-{
-    /* Unpack the preserved data */
-
-    int splitObjs = PTR2INT(data[0]);
-    CmdFrame *ctxPtr = data[1];
-    int pc = PTR2INT(data[2]);
-    const char *pattern = data[3];
-    int patternLength = strlen(pattern);
-
-    /*
-     * Clean up TIP 280 context information
-     */
+	/* 
+	 * 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.
+	 */
 
-    if (splitObjs) {
-	ckfree(ctxPtr->line);
-	if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
-	    /*
-	     * Death of SrcInfo reference.
-	     */
+	Tcl_SaveResult(interp, &state);
+	stateCode = iPtr->returnCode;
+	Tcl_UntraceCommand(interp, oldName, untraceFlags,
+		TraceCommandProc, clientData);
+	Tcl_RestoreResult(interp, &state);
+	iPtr->returnCode = stateCode;
 
-	    Tcl_DecrRefCount(ctxPtr->data.eval.path);
-	}
+	tcmdPtr->refCount--;
     }
-
-    /*
-     * 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 ? "..." : ""), Tcl_GetErrorLine(interp)));
+    tcmdPtr->refCount--;
+    if (tcmdPtr->refCount < 0) {
+	Tcl_Panic("TraceCommandProc: negative TraceCommandInfo refCount");
     }
-    TclStackFree(interp, ctxPtr);
-    return result;
+    if (tcmdPtr->refCount == 0) {
+        ckfree((char*)tcmdPtr);
+    }
+    return;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ThrowObjCmd --
+ * TclCheckExecutionTraces --
  *
- *	This procedure is invoked to process the "throw" Tcl command. See the
- *	user documentation for details on what it does.
+ *	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'
  *
  * Results:
- *	A standard Tcl result.
+ *      The return value is a standard Tcl completion code such as
+ *      TCL_OK or TCL_ERROR, etc.
  *
  * Side effects:
- *	See the user documentation.
+ *	Those side effects made by any trace procedures called.
  *
  *----------------------------------------------------------------------
  */
-
-	/* ARGSUSED */
-int
-Tcl_ThrowObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    Tcl_Obj *options;
-    int len;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "type message");
-	return TCL_ERROR;
-    }
-
-    /*
-     * The type must be a list of at least length 1.
-     */
-
-    if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
-	return TCL_ERROR;
-    } else if (len < 1) {
-	Tcl_AppendResult(interp, "type must be non-empty list", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
-		NULL);
-	return TCL_ERROR;
+    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;
+	}
     }
-
-    /*
-     * Now prepare the result options dictionary. We use the list API as it is
-     * slightly more convenient.
-     */
-
-    TclNewLiteralStringObj(options, "-code error -level 0 -errorcode");
-    Tcl_ListObjAppendElement(NULL, options, objv[1]);
-
-    /*
-     * We're ready to go. Fire things into the low-level result machinery.
-     */
-
-    Tcl_SetObjResult(interp, objv[2]);
-    return Tcl_SetReturnOptions(interp, options);
+    iPtr->activeCmdTracePtr = active.nextPtr;
+    return(traceCode);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_TimeObjCmd --
+ * TclCheckInterpTraces --
  *
- *	This object-based procedure is invoked to process the "time" Tcl
- *	command. See the user documentation for details on what it does.
+ *	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'
  *
  * Results:
- *	A standard Tcl object result.
+ *      The return value is a standard Tcl completion code such as
+ *      TCL_OK or TCL_ERROR, etc.
  *
  * Side effects:
- *	See the user documentation.
+ *	Those side effects made by any trace procedures called.
  *
  *----------------------------------------------------------------------
  */
-
-int
-Tcl_TimeObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    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
-
-    if (objc == 2) {
-	count = 1;
-    } else if (objc == 3) {
-	result = TclGetIntFromObj(interp, objv[2], &count);
-	if (result != TCL_OK) {
-	    return result;
+    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;
 	}
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "command ?count?");
-	return TCL_ERROR;
-    }
-
-    objPtr = objv[1];
-    i = count;
-#ifndef TCL_WIDE_CLICKS
-    Tcl_GetTime(&start);
-#else
-    start = TclpGetWideClicks();
-#endif
-    while (i-- > 0) {
-	result = Tcl_EvalObjEx(interp, objPtr, 0);
-	if (result != TCL_OK) {
-	    return result;
+	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);
 	}
     }
-#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
-
-    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);
-    }
-
-    /*
-     * Construct the result as a list because many programs have always parsed
-     * as such (extracting the first element, typically).
-     */
-
-    TclNewLiteralStringObj(objs[1], "microseconds");
-    TclNewLiteralStringObj(objs[2], "per");
-    TclNewLiteralStringObj(objs[3], "iteration");
-    Tcl_SetObjResult(interp, Tcl_NewListObj(4, objs));
-
-    return TCL_OK;
+    iPtr->activeInterpTracePtr = active.nextPtr;
+    return(traceCode);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_TryObjCmd, TclNRTryObjCmd --
+ * CallTraceProcedure --
  *
- *	This procedure is invoked to process the "try" Tcl command. See the
- *	user documentation (or TIP #329) for details on what it does.
+ *	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.
  *
  * Results:
- *	A standard Tcl object result.
+ *	None.
  *
  * Side effects:
- *	See the user documentation.
+ *	Those side effects made by the trace procedure.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_TryObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRTryObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL;
-    int i, bodyShared, haveHandlers, dummy, code;
-    static const char *const handlerNames[] = {
-	"finally", "on", "trap", NULL
-    };
-    enum Handlers {
-	TryFinally, TryOn, TryTrap
-    };
+    Interp *iPtr = (Interp *) interp;
+    char *commandCopy;
+    int traceCode;
 
-    /*
-     * Parse the arguments. The handlers are passed to subsequent callbacks as
-     * a Tcl_Obj list of the 5-tuples like (type, returnCode, errorCodePrefix,
-     * bindVariables, script), and the finally script is just passed as it is.
+   /*
+     * Copy the command characters into a new string.
      */
 
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"body ?handler ...? ?finally script?");
-	return TCL_ERROR;
-    }
-    bodyObj = objv[1];
-    handlersObj = Tcl_NewObj();
-    bodyShared = 0;
-    haveHandlers = 0;
-    for (i=2 ; i<objc ; i++) {
-	int type;
-	Tcl_Obj *info[5];
-
-	if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",
-		0, &type) != TCL_OK) {
-	    Tcl_DecrRefCount(handlersObj);
-	    return TCL_ERROR;
-	}
-	switch ((enum Handlers) type) {
-	case TryFinally:	/* finally script */
-	    if (i < objc-2) {
-		Tcl_AppendResult(interp, "finally clause must be last", NULL);
-		Tcl_DecrRefCount(handlersObj);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
-			"NONTERMINAL", NULL);
-		return TCL_ERROR;
-	    } else if (i == objc-1) {
-		Tcl_AppendResult(interp, "wrong # args to finally clause: ",
-			"must be \"", TclGetString(objv[0]),
-			" ... finally script\"", NULL);
-		Tcl_DecrRefCount(handlersObj);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
-			"ARGUMENT", NULL);
-		return TCL_ERROR;
-	    }
-	    finallyObj = objv[++i];
-	    break;
-
-	case TryOn:		/* on code variableList script */
-	    if (i > objc-4) {
-		Tcl_AppendResult(interp, "wrong # args to on clause: ",
-			"must be \"", TclGetString(objv[0]),
-			" ... on code variableList script\"", NULL);
-		Tcl_DecrRefCount(handlersObj);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
-			"ARGUMENT", NULL);
-		return TCL_ERROR;
-	    }
-	    if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) {
-		Tcl_DecrRefCount(handlersObj);
-		return TCL_ERROR;
-	    }
-	    info[2] = NULL;
-	    goto commonHandler;
-
-	case TryTrap:		/* trap pattern variableList script */
-	    if (i > objc-4) {
-		Tcl_AppendResult(interp, "wrong # args to trap clause: ",
-			"must be \"... trap pattern variableList script\"",
-			NULL);
-		Tcl_DecrRefCount(handlersObj);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
-			"ARGUMENT", NULL);
-		return TCL_ERROR;
-	    }
-	    code = 1;
-	    if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"bad prefix '%s': must be a list",
-			Tcl_GetString(objv[i+1])));
-		Tcl_DecrRefCount(handlersObj);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
-			"EXNFORMAT", NULL);
-		return TCL_ERROR;
-	    }
-	    info[2] = objv[i+1];
-
-	commonHandler:
-	    if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
-		Tcl_DecrRefCount(handlersObj);
-		return TCL_ERROR;
-	    }
-
-	    info[0] = objv[i];			/* type */
-	    TclNewIntObj(info[1], code);	/* returnCode */
-	    if (info[2] == NULL) {		/* errorCodePrefix */
-		TclNewObj(info[2]);
-	    }
-	    info[3] = objv[i+2];		/* bindVariables */
-	    info[4] = objv[i+3];		/* script */
-
-	    bodyShared = !strcmp(TclGetString(objv[i+3]), "-");
-	    Tcl_ListObjAppendElement(NULL, handlersObj,
-		    Tcl_NewListObj(5, info));
-	    haveHandlers = 1;
-	    i += 3;
-	    break;
-	}
-    }
-    if (bodyShared) {
-	Tcl_AppendResult(interp,
-		"last non-finally clause must not have a body of \"-\"",
-		NULL);
-	Tcl_DecrRefCount(handlersObj);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
-		NULL);
-	return TCL_ERROR;
-    }
-    if (!haveHandlers) {
-	Tcl_DecrRefCount(handlersObj);
-	handlersObj = NULL;
-    }
-
+    commandCopy = (char *) ckalloc((unsigned) (numChars + 1));
+    memcpy((VOID *) commandCopy, (VOID *) command, (size_t) numChars);
+    commandCopy[numChars] = '\0';
+    
     /*
-     * Execute the body.
+     * 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_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
-	    (ClientData)objv, INT2PTR(objc));
-    return TclNREvalObjEx(interp, bodyObj, 0,
-	    ((Interp *) interp)->cmdFramePtr, 1);
+    ckfree((char *) commandCopy);
+    return(traceCode);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * During --
+ * CommandObjTraceDeleted --
  *
- *	This helper function patches together the updates to the interpreter's
- *	return options that are needed when things fail during the processing
- *	of a handler or finally script for the [try] command.
+ *	Ensure the trace is correctly deleted by decrementing its
+ *	refCount and only deleting if no other references exist.
  *
- * Returns:
- *	The new option dictionary.
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *	May release memory.
  *
  *----------------------------------------------------------------------
  */
-
-static inline Tcl_Obj *
-During(
-    Tcl_Interp *interp,
-    int resultCode,		/* The result code from the just-evaluated
-				 * script. */
-    Tcl_Obj *oldOptions,	/* The old option dictionary. */
-    Tcl_Obj *errorInfo)		/* An object to append to the errorinfo and
-				 * release, or NULL if nothing is to be added.
-				 * Designed to be used with Tcl_ObjPrintf. */
-{
-    Tcl_Obj *during, *options;
-
-    if (errorInfo != NULL) {
-	Tcl_AppendObjToErrorInfo(interp, errorInfo);
+static void 
+CommandObjTraceDeleted(ClientData clientData) {
+    TraceCommandInfo* tcmdPtr = (TraceCommandInfo*)clientData;
+    tcmdPtr->refCount--;
+    if (tcmdPtr->refCount < 0) {
+	Tcl_Panic("CommandObjTraceDeleted: negative TraceCommandInfo refCount");
+    }
+    if (tcmdPtr->refCount == 0) {
+        ckfree((char*)tcmdPtr);
     }
-    options = Tcl_GetReturnOptions(interp, resultCode);
-    TclNewLiteralStringObj(during, "-during");
-    Tcl_IncrRefCount(during);
-    Tcl_DictObjPut(interp, options, during, oldOptions);
-    Tcl_DecrRefCount(during);
-    Tcl_IncrRefCount(options);
-    Tcl_DecrRefCount(oldOptions);
-    return options;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TryPostBody --
+ * TraceExecutionProc --
+ *
+ *	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.
+ *
+ * Results:
+ *      The return value is a standard Tcl completion code such as
+ *      TCL_OK or TCL_ERROR, etc.
  *
- *	Callback to handle the outcome of the execution of the body of a 'try'
- *	command.
+ * Side effects:
+ *	May invoke an arbitrary Tcl procedure, and may create or
+ *	delete an interpreter-wide trace.
  *
  *----------------------------------------------------------------------
  */
-
 static int
-TryPostBody(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
-    int i, dummy, code, objc;
-    int numHandlers = 0;
-
-    handlersObj = data[0];
-    finallyObj = data[1];
-    objv = data[2];
-    objc = PTR2INT(data[3]);
-
-    cmdObj = objv[0];
-
-    /*
-     * Check for limits/rewinding, which override normal trapping behaviour.
-     */
-
-    if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"%s\" body line %d)", TclGetString(cmdObj),
-		Tcl_GetErrorLine(interp)));
-	if (handlersObj != NULL) {
-	    Tcl_DecrRefCount(handlersObj);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Basic processing of the outcome of the script, including adding of
-     * errorinfo trace.
-     */
-
-    if (result == TCL_ERROR) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"%s\" body line %d)", TclGetString(cmdObj),
-		Tcl_GetErrorLine(interp)));
+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;
     }
-    resultObj = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(resultObj);
-    options = Tcl_GetReturnOptions(interp, result);
-    Tcl_IncrRefCount(options);
-    Tcl_ResetResult(interp);
-
-    /*
-     * Handle the results.
-     */
-
-    if (handlersObj != NULL) {
-	int found = 0;
-	Tcl_Obj **handlers, **info;
-
-	Tcl_ListObjGetElements(NULL, handlersObj, &numHandlers, &handlers);
-	for (i=0 ; i<numHandlers ; i++) {
-	    Tcl_Obj *handlerBodyObj;
+    
+    if (!Tcl_InterpDeleted(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) {
+	    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);
+	        }
+	    }
+	}
+	
+	/*
+	 * Second, create the tcl callback, if required.
+	 */
+	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);
 
-	    Tcl_ListObjGetElements(NULL, handlers[i], &dummy, &info);
-	    if (!found) {
-		Tcl_GetIntFromObj(NULL, info[1], &code);
-		if (code != result) {
-		    continue;
+	    if (flags & TCL_TRACE_ENTER_EXEC) {
+		/* Append trace operation */
+		if (flags & TCL_TRACE_EXEC_DIRECT) {
+		    Tcl_DStringAppendElement(&cmd, "enter");
+		} else {
+		    Tcl_DStringAppendElement(&cmd, "enterstep");
 		}
-
-		/*
-		 * When processing an error, we must also perform list-prefix
-		 * matching of the errorcode list. However, if this was an
-		 * 'on' handler, the list that we are matching against will be
-		 * empty.
-		 */
-
-		if (code == TCL_ERROR) {
-		    Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
-		    int len1, len2, j;
-
-		    TclNewLiteralStringObj(errorCodeName, "-errorcode");
-		    Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
-		    Tcl_DecrRefCount(errorCodeName);
-		    Tcl_ListObjGetElements(NULL, info[2], &len1, &bits1);
-		    if (Tcl_ListObjGetElements(NULL, errcode, &len2,
-			    &bits2) != TCL_OK) {
-			continue;
-		    }
-		    if (len2 < len1) {
-			continue;
-		    }
-		    for (j=0 ; j<len1 ; j++) {
-			if (strcmp(TclGetString(bits1[j]),
-				TclGetString(bits2[j])) != 0) {
-			    /*
-			     * Really want 'continue outerloop;', but C does
-			     * not give us that.
-			     */
-
-			    goto didNotMatch;
-			}
-		    }
+	    } 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");
 		}
-
-		found = 1;
+	    } else {
+		panic("TraceExecutionProc: bad flag combination");
 	    }
-
+	    
 	    /*
-	     * Now we need to scan forward over "-" bodies. Note that we've
-	     * already checked that the last body is not a "-", so this search
-	     * will terminate successfully.
+	     * 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.
 	     */
 
-	    if (!strcmp(TclGetString(info[4]), "-")) {
-		continue;
-	    }
-
-	    /*
-	     * Bind the variables. We already know this is a list of variable
-	     * names, but it might be empty.
+	    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.
 	     */
-
-	    Tcl_ResetResult(interp);
-	    result = TCL_ERROR;
-	    Tcl_ListObjLength(NULL, info[3], &dummy);
-	    if (dummy > 0) {
-		Tcl_Obj *varName;
-
-		Tcl_ListObjIndex(NULL, info[3], 0, &varName);
-		if (Tcl_ObjSetVar2(interp, varName, NULL, resultObj,
-			TCL_LEAVE_ERR_MSG) == NULL) {
-		    Tcl_DecrRefCount(resultObj);
-		    goto handlerFailed;
-		}
-		Tcl_DecrRefCount(resultObj);
-		if (dummy > 1) {
-		    Tcl_ListObjIndex(NULL, info[3], 1, &varName);
-		    if (Tcl_ObjSetVar2(interp, varName, NULL, options,
-			    TCL_LEAVE_ERR_MSG) == NULL) {
-			goto handlerFailed;
-		    }
-		}
-	    } else {
-		/*
-		 * Dispose of the result to prevent a memleak. [Bug 2910044]
-		 */
-
-		Tcl_DecrRefCount(resultObj);
-	    }
+	    traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
+	    tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
 
 	    /*
-	     * Evaluate the handler body and process the outcome. Note that we
-	     * need to keep the kind of handler for debugging purposes, and in
-	     * any case anything we want from info[] must be extracted right
-	     * now because the info[] array is about to become invalid. There
-	     * is very little refcount handling here however, since we know
-	     * that the objects that we still want to refer to now were input
-	     * arguments to [try] and so are still on the Tcl value stack.
+	     * Restore the interp tracing flag to prevent cmd traces
+	     * from affecting interp traces
 	     */
+	    iPtr->flags = saveInterpFlags;;
+	    if (tcmdPtr->flags == 0) {
+		flags |= TCL_TRACE_DESTROYED;
+	    }
+	    
+            if (traceCode == TCL_OK) {
+		/* Restore result if trace execution was successful */
+		Tcl_RestoreResult(interp, &state);
+		iPtr->returnCode = stateCode;
+            } else {
+		Tcl_DiscardResult(&state);
+	    }
 
-	    handlerBodyObj = info[4];
-	    Tcl_NRAddCallback(interp, TryPostHandler, objv, options, info[0],
-		    INT2PTR((finallyObj == NULL) ? 0 : objc - 1));
-	    Tcl_DecrRefCount(handlersObj);
-	    return TclNREvalObjEx(interp, handlerBodyObj, 0,
-		    ((Interp *) interp)->cmdFramePtr, 4*i + 5);
-
-	handlerFailed:
-	    resultObj = Tcl_GetObjResult(interp);
-	    Tcl_IncrRefCount(resultObj);
-	    options = During(interp, result, options, NULL);
-	    break;
-
-	didNotMatch:
-	    continue;
+	    Tcl_DStringFree(&cmd);
 	}
-
+	
 	/*
-	 * No handler matched; get rid of the list of handlers.
+	 * 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.
 	 */
-
-	Tcl_DecrRefCount(handlersObj);
+	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);
+	}
     }
-
-    /*
-     * Process the finally clause.
-     */
-
-    if (finallyObj != NULL) {
-	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
-		NULL);
-	return TclNREvalObjEx(interp, finallyObj, 0,
-		((Interp *) interp)->cmdFramePtr, objc - 1);
+    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);
+	    }
+	}
     }
-
-    /*
-     * Install the correct result/options into the interpreter and clean up
-     * any temporary storage.
-     */
-
-    result = Tcl_SetReturnOptions(interp, options);
-    Tcl_DecrRefCount(options);
-    Tcl_SetObjResult(interp, resultObj);
-    Tcl_DecrRefCount(resultObj);
-    return result;
+    if (call) {
+	tcmdPtr->refCount--;
+	if (tcmdPtr->refCount < 0) {
+	    Tcl_Panic("TraceExecutionProc: negative TraceCommandInfo refCount");
+	}
+	if (tcmdPtr->refCount == 0) {
+	    ckfree((char*)tcmdPtr);
+	}
+    }
+    return traceCode;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TryPostHandler --
+ * TraceVarProc --
+ *
+ *	This procedure is called to handle variable accesses that have
+ *	been traced using the "trace" command.
  *
- *	Callback to handle the outcome of the execution of a handler of a
- *	'try' command.
+ * Results:
+ *	Normally returns NULL.  If the trace command returns an error,
+ *	then this procedure returns an error string.
+ *
+ * Side effects:
+ *	Depends on the command associated with the trace.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-TryPostHandler(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
+	/* 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. */
 {
-    Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
-    Tcl_Obj *finallyObj;
-    int finally;
-
-    objv = data[0];
-    options = data[1];
-    handlerKindObj = data[2];
-    finally = PTR2INT(data[3]);
-
-    cmdObj = objv[0];
-    finallyObj = finally ? objv[finally] : 0;
-
-    /*
-     * Check for limits/rewinding, which override normal trapping behaviour.
-     */
-
-    if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) {
-	options = During(interp, result, options, Tcl_ObjPrintf(
-		"\n    (\"%s ... %s\" handler line %d)",
-		TclGetString(cmdObj), TclGetString(handlerKindObj),
-		Tcl_GetErrorLine(interp)));
-	Tcl_DecrRefCount(options);
-	return TCL_ERROR;
-    }
-
-    /*
-     * The handler result completely substitutes for the result of the body.
+    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]
      */
 
-    resultObj = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(resultObj);
-    if (result == TCL_ERROR) {
-	options = During(interp, result, options, Tcl_ObjPrintf(
-		"\n    (\"%s ... %s\" handler line %d)",
-		TclGetString(cmdObj), TclGetString(handlerKindObj),
-		Tcl_GetErrorLine(interp)));
-    } else {
-	Tcl_DecrRefCount(options);
-	options = Tcl_GetReturnOptions(interp, result);
-	Tcl_IncrRefCount(options);
-    }
-
-    /*
-     * Process the finally clause if it is present.
-     */
-
-    if (finallyObj != NULL) {
-	Interp *iPtr = (Interp *) interp;
-
-	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
-		NULL);
-
-	/* The 'finally' script is always the last argument word. */
-	return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr,
-		finally);
-    }
-
-    /*
-     * Install the correct result/options into the interpreter and clean up
-     * any temporary storage.
-     */
-
-    result = Tcl_SetReturnOptions(interp, options);
-    Tcl_DecrRefCount(options);
-    Tcl_SetObjResult(interp, resultObj);
-    Tcl_DecrRefCount(resultObj);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TryPostFinal --
- *
- *	Callback to handle the outcome of the execution of the finally script
- *	of a 'try' command.
- *
- *----------------------------------------------------------------------
- */
+    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. 
+	     */
 
-static int
-TryPostFinal(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj *resultObj, *options, *cmdObj;
+	    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.  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.
+	     */
 
-    resultObj = data[0];
-    options = data[1];
-    cmdObj = data[2];
+	    Tcl_SaveResult(interp, &state);
+	    if ((flags & TCL_TRACE_DESTROYED)
+		    && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) {
+		destroy = 1;
+		tvarPtr->flags |= TCL_TRACE_DESTROYED;
+	    }
 
-    /*
-     * If the result wasn't OK, we need to adjust the result options.
-     */
+	    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;
+	    }
 
-    if (result != TCL_OK) {
-	Tcl_DecrRefCount(resultObj);
-	resultObj = NULL;
-	if (result == TCL_ERROR) {
-	    options = During(interp, result, options, Tcl_ObjPrintf(
-		    "\n    (\"%s ... finally\" body line %d)",
-		    TclGetString(cmdObj), Tcl_GetErrorLine(interp)));
-	} else {
-	    Tcl_Obj *origOptions = options;
+	    Tcl_RestoreResult(interp, &state);
 
-	    options = Tcl_GetReturnOptions(interp, result);
-	    Tcl_IncrRefCount(options);
-	    Tcl_DecrRefCount(origOptions);
+	    Tcl_DStringFree(&cmd);
 	}
     }
+    if (destroy) {
+	if (result != NULL) {
+	    register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
 
-    /*
-     * Install the correct result/options into the interpreter and clean up
-     * any temporary storage.
-     */
-
-    result = Tcl_SetReturnOptions(interp, options);
-    Tcl_DecrRefCount(options);
-    if (resultObj != NULL) {
-	Tcl_SetObjResult(interp, resultObj);
-	Tcl_DecrRefCount(resultObj);
+	    Tcl_DecrRefCount(errMsgObj);
+	    result = NULL;
+	}
     }
     return result;
 }
@@ -4670,110 +4936,108 @@ TryPostFinal(
  *
  * 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRWhileObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRWhileObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    ForIterData *iterPtr;
+    int result, value;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "test command");
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
 
-    /*
-     * We reuse [for]'s callback, passing a NULL for the 'next' script.
-     */
-
-    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
-    iterPtr->cond = objv[1];
-    iterPtr->body = objv[2];
-    iterPtr->next = NULL;
-    iterPtr->msg  = "\n    (\"while\" body line %d)";
-    iterPtr->word = 2;
+    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];
 
-    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
-	    NULL, NULL);
-    return TCL_OK;
+                sprintf(msg, "\n    (\"while\" body line %d)",
+                        interp->errorLine);
+                Tcl_AddErrorInfo(interp, msg);
+            }
+            break;
+        }
+    }
+    if (result == TCL_BREAK) {
+        result = TCL_OK;
+    }
+    if (result == TCL_OK) {
+        Tcl_ResetResult(interp);
+    }
+    return result;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * 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 */
+#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 */
 {
-    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          i;
+    CONST char*  listStr  = Tcl_GetString (listObj);
+    CONST char*  listHead = listStr;
+    int          length   = strlen( listStr);
+    CONST char*  element  = NULL;
+    CONST char*  next     = NULL;
+    ContLineLoc* clLocPtr = TclContinuationsGet(listObj);
+    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 */
-	TclAdvanceContinuations(&line, &clNext, element - listHead);
-	if (elems && clNext) {
-	    TclContinuationsEnterDerived(elems[i], element-listHead, clNext);
+	TclAdvanceLines (&line, listStr, element); /* Leading whitespace */
+	TclAdvanceContinuations (&line, &clNext, element - listHead);
+	if (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 */
@@ -4781,6 +5045,7 @@ TclListLines(
 	}
     }
 }
+#endif
 
 /*
  * Local Variables:
@@ -4789,3 +5054,4 @@ TclListLines(
  * fill-column: 78
  * End:
  */
+
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 5b7e0a5..a39370e 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -1,16 +1,15 @@
-/*
+/* 
  * 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"
@@ -20,102 +19,60 @@
  * Prototypes for procedures defined later in this file:
  */
 
-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 void		CompileReturnInternal(CompileEnv *envPtr,
-			    unsigned char op, int code, int level,
-			    Tcl_Obj *returnOpts);
-static int		IndexTailVarIfKnown(Tcl_Interp *interp,
-			    Tcl_Token *varTokenPtr, CompileEnv *envPtr);
-static int		PushVarName(Tcl_Interp *interp,
-			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
-			    int flags, int *localIndexPtr,
-			    int *simpleVarNamePtr, int *isScalarPtr,
-			    int line, int *clNext);
-
-/*
- * 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);
- */
-
-#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.
- *
- * Macro to encapsulate the variable definition and setup.
+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)])
+
+/* 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.
  */
-
 #define DefineLineInformation \
-    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
+    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
     int eclIndex = mapPtr->nuloc - 1
 
 #define SetLineInformation(word) \
-    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
-    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
-
-#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)])
+    envPtr->line   = mapPtr->loc [eclIndex].line [(word)]; \
+    envPtr->clNext = mapPtr->loc [eclIndex].next [(word)]
+#endif
 
 /*
- * Often want to issue one of two versions of an instruction based on whether
- * the argument will fit in a single byte or not. This makes it much clearer.
+ * Flags bits used by TclPushVarName.
  */
 
-#define Emit14Inst(nm,idx,envPtr) \
-    if (idx <= 255) {							\
-	TclEmitInstInt1(nm##1,idx,envPtr);				\
-    } else {								\
-	TclEmitInstInt4(nm##4,idx,envPtr);				\
-    }
-
-/*
- * Flags bits used by PushVarName.
- */
-
-#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
+#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.
  */
 
-const AuxDataType tclForeachInfoType = {
-    "ForeachInfo",		/* name */
-    DupForeachInfo,		/* dupProc */
-    FreeForeachInfo,		/* freeProc */
-    PrintForeachInfo		/* printProc */
-};
-
-const AuxDataType tclDictUpdateInfoType = {
-    "DictUpdateInfo",		/* name */
-    DupDictUpdateInfo,		/* dupProc */
-    FreeDictUpdateInfo,		/* freeProc */
-    PrintDictUpdateInfo		/* printProc */
+AuxDataType tclForeachInfoType = {
+    "ForeachInfo",				/* name */
+    DupForeachInfo,				/* dupProc */
+    FreeForeachInfo				/* freeProc */
 };
 
 /*
@@ -126,68 +83,89 @@ const AuxDataType tclDictUpdateInfoType = {
  *	Procedure called to compile the "append" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     Tcl_Token *varTokenPtr, *valueTokenPtr;
     int simpleVarName, isScalar, localIndex, numWords;
-    DefineLineInformation;	/* TIP #280 */
+    int code = TCL_OK;
+
+    DefineLineInformation;
 
     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, cmdPtr, envPtr);
+        return TclCompileSetCmd(interp, parsePtr, envPtr);
     } else if (numWords > 3) {
 	/*
-	 * APPEND instructions currently only handle one value.
+	 * APPEND instructions currently only handle one value
 	 */
-
-	return TCL_ERROR;
+        return TCL_OUT_LINE_COMPILE;
     }
 
     /*
-     * 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 = TokenAfter(parsePtr->tokenPtr);
+    varTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
 
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
 	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (code != TCL_OK) {
+	goto done;
+    }
 
     /*
-     * 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 = TokenAfter(varTokenPtr);
-	CompileWord(envPtr, valueTokenPtr, interp, 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;
+	    }
+	}
     }
 
     /*
@@ -196,23 +174,32 @@ TclCompileAppendCmd(
 
     if (simpleVarName) {
 	if (isScalar) {
-	    if (localIndex < 0) {
-		TclEmitOpcode(INST_APPEND_STK, envPtr);
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
+		} else {
+		    TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
+		}
 	    } else {
-		Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr);
+		TclEmitOpcode(INST_APPEND_STK, envPtr);
 	    }
 	} else {
-	    if (localIndex < 0) {
-		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
+	    if (localIndex >= 0) {
+		if (localIndex <= 255) {
+		    TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
+		} else {
+		    TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
+		}
 	    } else {
-		Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr);
+		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
 	    }
 	}
     } else {
 	TclEmitOpcode(INST_APPEND_STK, envPtr);
     }
 
-    return TCL_OK;
+    done:
+    return code;
 }
 
 /*
@@ -223,26 +210,28 @@ TclCompileAppendCmd(
  *	Procedure called to compile the "break" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     if (parsePtr->numWords != 1) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"break\"", -1);
 	return TCL_ERROR;
     }
 
@@ -262,259 +251,172 @@ TclCompileBreakCmd(
  *	Procedure called to compile the "catch" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     JumpFixup jumpFixup;
-    Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
-    const char *name;
-    int resultIndex, optsIndex, nameChars, range;
-    int initStackDepth = envPtr->currStackDepth;
-    int savedStackDepth;
-    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *cmdTokenPtr, *nameTokenPtr;
+    CONST char *name;
+    int localIndex, nameChars, range, startOffset, jumpDist;
+    int code;
+    int savedStackDepth = envPtr->currStackDepth;
 
-    /*
-     * If syntax does not match what we expect for [catch], do not compile.
-     * Let runtime checks determine if syntax has changed.
-     */
+    DefineLineInformation;
 
-    if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) {
+    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"catch command ?varName?\"", -1);
 	return TCL_ERROR;
     }
 
     /*
-     * 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 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 ((parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) {
-	return TCL_ERROR;
+    if ((parsePtr->numWords == 3) && (envPtr->procPtr == NULL)) {
+	return TCL_OUT_LINE_COMPILE;
     }
 
     /*
-     * Make sure the variable names, if any, have no substitutions and just
-     * refer to local scalars.
+     * Make sure the variable name, if any, has no substitutions and just
+     * refers to a local scaler.
      */
 
-    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);
-	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;
+    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;
 	    if (!TclIsLocalScalar(name, nameChars)) {
-		return TCL_ERROR;
-	    }
-	    optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
-		    optsNameTokenPtr[1].size, /*create*/ 1, envPtr);
-	    if (optsIndex < 0) {
-		return TCL_ERROR;
+		return TCL_OUT_LINE_COMPILE;
 	    }
+	    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. Declare the exception range that it
-     * uses.
+     * We will compile the catch command. Emit a beginCatch instruction at
+     * the start of the catch body: the subcommand it controls.
      */
-
-    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
+    
+    envPtr->exceptDepth++;
+    envPtr->maxExceptDepth =
+	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+    TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
 
     /*
-     * 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.
+     * 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]
      */
 
-    SetLineInformation(1);
+    SetLineInformation (1);
     if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	savedStackDepth = envPtr->currStackDepth;
-	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
-	ExceptionRangeStarts(envPtr, range);
-	CompileBody(envPtr, cmdTokenPtr, interp);
+	startOffset = (envPtr->codeNext - envPtr->codeStart);
+	code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
     } else {
-	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);
-    }
-    /* Stack at this point:
-     *    nonsimple:  script <mark> result
-     *    simple:            <mark> result
-     */
-
-    if (resultIndex == -1) {
-	/*
-	 * Special case when neither result nor options are being saved. In
-	 * that case, we can skip quite a bit of the command epilogue; all we
-	 * have to do is drop the result and push the return code (and, of
-	 * course, finish the catch context).
-	 */
-
-	TclEmitOpcode(		INST_POP,			envPtr);
-	PushLiteral(envPtr, "0", 1);
-	TclEmitInstInt1(	INST_JUMP1, 3,			envPtr);
-	envPtr->currStackDepth = savedStackDepth;
-	ExceptionRangeTarget(envPtr, range, catchOffset);
-	TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);
-	ExceptionRangeEnds(envPtr, range);
-	TclEmitOpcode(		INST_END_CATCH,			envPtr);
-
-	/*
-	 * Stack at this point:
-	 *    nonsimple:  script <mark> returnCode
-	 *    simple:            <mark> returnCode
-	 */
-
-	goto dropScriptAtEnd;
+	code = TclCompileTokens(interp, cmdTokenPtr+1,
+	        cmdTokenPtr->numComponents, envPtr);
+	startOffset = (envPtr->codeNext - envPtr->codeStart);
+	TclEmitOpcode(INST_EVAL_STK, envPtr);
     }
+    envPtr->exceptArrayPtr[range].codeOffset = startOffset;
 
-    /*
-     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
-     * and jump around the "error case" code.
-     */
-
-    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));
+    if (code != TCL_OK) {
+	code = TCL_OUT_LINE_COMPILE;
+	goto done;
     }
-
-    /*
-     * 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);
-
+    envPtr->exceptArrayPtr[range].numCodeBytes =
+	    (envPtr->codeNext - envPtr->codeStart) - startOffset;
+		    
     /*
-     * 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.
+     * 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"
+     * result, and jump around the "error case" code.
      */
 
-    if (optsIndex != -1) {
-	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
-    } else {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+    if (localIndex != -1) {
+	if (localIndex <= 255) {
+	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
+	} else {
+	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	}
     }
+    TclEmitOpcode(INST_POP, envPtr);
+    TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
 
     /*
-     * Store the result and remove it from the stack.
-     */
-
-    Emit14Inst(			INST_STORE_SCALAR, resultIndex,	envPtr);
-    TclEmitOpcode(		INST_POP,			envPtr);
-
-    /*
-     * 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.
+     * 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.
      */
 
-    if (optsIndex != -1) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
+    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);
+	} else {
+	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	}
+	TclEmitOpcode(INST_POP, envPtr);
     }
+    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
 
-  dropScriptAtEnd:
 
     /*
-     * Stack is now ?script? result. Get rid of the subst'ed script if it's
-     * hanging arond.
+     * Update the target of the jump after the "no errors" code, then emit
+     * an endCatch instruction at the end of the catch command.
      */
 
-    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
+    jumpDist = (envPtr->codeNext - envPtr->codeStart)
+	    - jumpFixup.codeOffset;
+    if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
+	panic("TclCompileCatchCmd: bad jump distance %d\n", jumpDist);
     }
+    TclEmitOpcode(INST_END_CATCH, envPtr);
 
-    /* 
-     * 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;
+    done:
+    envPtr->currStackDepth = savedStackDepth + 1;
+    envPtr->exceptDepth--;
+    return code;
 }
 
 /*
@@ -525,30 +427,32 @@ TclCompileCatchCmd(
  *	Procedure called to compile the "continue" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     /*
      * 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;
     }
 
@@ -563,1118 +467,45 @@ TclCompileContinueCmd(
 /*
  *----------------------------------------------------------------------
  *
- * 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;
-    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) {
-	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, envPtr);
-    if (dictVarIndex < 0) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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. */
-{
-    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) {
-	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, envPtr);
-    if (dictVarIndex < 0) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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. */
-{
-    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) {
-	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(argv);
-	return TCL_ERROR;
-    }
-
-    nameChars = strlen(argv[0]);
-    if (!TclIsLocalScalar(argv[0], nameChars)) {
-	ckfree(argv);
-	return TCL_ERROR;
-    }
-    keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, envPtr);
-
-    nameChars = strlen(argv[1]);
-    if (!TclIsLocalScalar(argv[1], nameChars)) {
-	ckfree(argv);
-	return TCL_ERROR;
-    }
-    valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, envPtr);
-    ckfree(argv);
-
-    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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, envPtr);
-    if (infoIndex < 0) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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);
-    Emit14Inst(		INST_STORE_SCALAR, keyVarIndex,		envPtr);
-    TclEmitOpcode(	INST_POP,				envPtr);
-    Emit14Inst(		INST_STORE_SCALAR, 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);
-    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
-    TclEmitInt4(	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);
-    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
-    TclEmitInt4(	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);
-    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
-    TclEmitInt4(	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. */
-{
-    DefineLineInformation;	/* TIP #280 */
-    const char *name;
-    int i, nameChars, dictIndex, numVars, range, infoIndex;
-    Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr;
-    int savedStackDepth = envPtr->currStackDepth;
-    DictUpdateInfo *duiPtr;
-    JumpFixup jumpFixup;
-
-    /*
-     * There must be at least one argument after the command.
-     */
-
-    if (parsePtr->numWords < 5) {
-	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, envPtr);
-    if (dictIndex < 0) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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 = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
-    duiPtr->length = numVars;
-    keyTokenPtrs = 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) {
-	    goto failedUpdateInfoAssembly;
-	}
-	name = tokenPtr[1].start;
-	nameChars = tokenPtr[1].size;
-	if (!TclIsLocalScalar(name, nameChars)) {
-	    goto failedUpdateInfoAssembly;
-	}
-
-	/*
-	 * Stash the index in the auxiliary data.
-	 */
-
-	duiPtr->varIndices[i] =
-		TclFindCompiledLocal(name, nameChars, 1, envPtr);
-	if (duiPtr->varIndices[i] < 0) {
-	    goto failedUpdateInfoAssembly;
-	}
-	tokenPtr = TokenAfter(tokenPtr);
-    }
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-    failedUpdateInfoAssembly:
-	ckfree(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);
-    envPtr->currStackDepth++;
-    SetLineInformation(parsePtr->numWords - 1);
-    CompileBody(envPtr, bodyTokenPtr, interp);
-    envPtr->currStackDepth = savedStackDepth;
-    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. */
-{
-    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) {
-	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, envPtr);
-	if (dictVarIndex < 0) {
-	    return TCL_ERROR;
-	}
-    }
-
-    /*
-     * 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. */
-{
-    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) {
-	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, envPtr);
-    if (dictVarIndex < 0) {
-	return TCL_ERROR;
-    }
-    CompileWord(envPtr, keyTokenPtr, interp, 3);
-    CompileWord(envPtr, valueTokenPtr, interp, 4);
-    TclEmitInstInt4(	INST_DICT_LAPPEND, dictVarIndex,	envPtr);
-    return TCL_OK;
-}
-
-int
-TclCompileDictWithCmd(
-    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. */
-{
-    DefineLineInformation;	/* TIP #280 */
-    int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1;
-    int bodyIsEmpty = 1;
-    Tcl_Token *varTokenPtr, *tokenPtr;
-    int savedStackDepth = envPtr->currStackDepth;
-    JumpFixup jumpFixup;
-    const char *ptr, *end;
-
-    /*
-     * There must be at least one argument after the command.
-     */
-
-    if (parsePtr->numWords < 3) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Parse the command (trivially). Expect the following:
-     *   dict with <any (varName)> ?<any> ...? <literal>
-     */
-
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    tokenPtr = TokenAfter(varTokenPtr);
-    for (i=3 ; i<parsePtr->numWords ; i++) {
-	tokenPtr = TokenAfter(tokenPtr);
-    }
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Test if the last word is an empty script; if so, we can compile it in
-     * all cases, but if it is non-empty we need local variable table entries
-     * to hold the temporary variables (used to keep stack usage simple).
-     */
-
-    for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) {
-	if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') {
-	    if (envPtr->procPtr == NULL) {
-		return TCL_ERROR;
-	    }
-	    bodyIsEmpty = 0;
-	    break;
-	}
-    }
-
-    /*
-     * Determine if we're manipulating a dict in a simple local variable.
-     */
-
-    gotPath = (parsePtr->numWords > 3);
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD &&
-	    TclIsLocalScalar(varTokenPtr[1].start, varTokenPtr[1].size)) {
-	dictVar = TclFindCompiledLocal(varTokenPtr[1].start,
-		varTokenPtr[1].size, 1, envPtr);
-    }
-
-    /*
-     * Special case: an empty body means we definitely have no need to issue
-     * try-finally style code or to allocate local variable table entries for
-     * storing temporaries. Still need to do both INST_DICT_EXPAND and
-     * INST_DICT_RECOMBINE_* though, because we can't determine if we're free
-     * of traces.
-     */
-
-    if (bodyIsEmpty) {
-	if (dictVar >= 0) {
-	    if (gotPath) {
-		/*
-		 * Case: Path into dict in LVT with empty body.
-		 */
-
-		tokenPtr = TokenAfter(varTokenPtr);
-		for (i=2 ; i<parsePtr->numWords-1 ; i++) {
-		    CompileWord(envPtr, tokenPtr, interp, i-1);
-		    tokenPtr = TokenAfter(tokenPtr);
-		}
-		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
-		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
-		TclEmitInstInt4(INST_OVER, 1,			envPtr);
-		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
-		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
-		PushLiteral(envPtr, "", 0);
-	    } else {
-		/*
-		 * Case: Direct dict in LVT with empty body.
-		 */
-
-		PushLiteral(envPtr, "", 0);
-		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
-		PushLiteral(envPtr, "", 0);
-		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
-		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
-		PushLiteral(envPtr, "", 0);
-	    }
-	} else {
-	    if (gotPath) {
-		/*
-		 * Case: Path into dict in non-simple var with empty body.
-		 */
-
-		tokenPtr = varTokenPtr;
-		for (i=1 ; i<parsePtr->numWords-1 ; i++) {
-		    CompileWord(envPtr, tokenPtr, interp, i-1);
-		    tokenPtr = TokenAfter(tokenPtr);
-		}
-		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
-		TclEmitInstInt4(INST_OVER, 1,			envPtr);
-		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
-		TclEmitInstInt4(INST_OVER, 1,			envPtr);
-		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
-		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
-		PushLiteral(envPtr, "", 0);
-	    } else {
-		/*
-		 * Case: Direct dict in non-simple var with empty body.
-		 */
-
-		CompileWord(envPtr, varTokenPtr, interp, 0);
-		TclEmitOpcode(	INST_DUP,			envPtr);
-		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
-		PushLiteral(envPtr, "", 0);
-		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
-		PushLiteral(envPtr, "", 0);
-		TclEmitInstInt4(INST_REVERSE, 2,		envPtr);
-		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
-		PushLiteral(envPtr, "", 0);
-	    }
-	}
-	return TCL_OK;
-    }
-
-    /*
-     * OK, we have a non-trivial body. This means that the focus is on
-     * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes
-     * in the 'finally' clause.
-     *
-     * Start by allocating local (unnamed, untraced) working variables.
-     */
-
-    if (dictVar == -1) {
-	varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
-    } else {
-	varNameTmp = -1;
-    }
-    if (gotPath) {
-	pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
-    } else {
-	pathTmp = -1;
-    }
-    keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
-
-    /*
-     * Issue instructions. First, the part to expand the dictionary.
-     */
-
-    if (varNameTmp > -1) {
-	CompileWord(envPtr, varTokenPtr, interp, 0);
-	Emit14Inst(		INST_STORE_SCALAR, varNameTmp,	envPtr);
-    }
-    tokenPtr = TokenAfter(varTokenPtr);
-    if (gotPath) {
-	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
-	    CompileWord(envPtr, tokenPtr, interp, i-1);
-	    tokenPtr = TokenAfter(tokenPtr);
-	}
-	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);
-	Emit14Inst(		INST_STORE_SCALAR, pathTmp,	envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-    }
-    if (dictVar == -1) {
-	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
-    } else {
-	Emit14Inst(		INST_LOAD_SCALAR, dictVar,	envPtr);
-    }
-    if (gotPath) {
-	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
-    } else {
-	PushLiteral(envPtr, "", 0);
-    }
-    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);
-    Emit14Inst(			INST_STORE_SCALAR, keysTmp,	envPtr);
-    TclEmitOpcode(		INST_POP,			envPtr);
-
-    /*
-     * Now the body of the [dict with].
-     */
-
-    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
-    TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);
-
-    ExceptionRangeStarts(envPtr, range);
-    envPtr->currStackDepth++;
-    SetLineInformation(parsePtr->numWords-1);
-    CompileBody(envPtr, tokenPtr, interp);
-    envPtr->currStackDepth = savedStackDepth;
-    ExceptionRangeEnds(envPtr, range);
-
-    /*
-     * Now fold the results back into the dictionary in the OK case.
-     */
-
-    TclEmitOpcode(		INST_END_CATCH,			envPtr);
-    if (varNameTmp > -1) {
-	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
-    }
-    if (gotPath) {
-	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
-    } else {
-	PushLiteral(envPtr, "", 0);
-    }
-    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
-    if (dictVar == -1) {
-	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
-    } else {
-	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
-    }
-    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
-
-    /*
-     * Now fold the results back into the dictionary in the exception case.
-     */
-
-    ExceptionRangeTarget(envPtr, range, catchOffset);
-    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
-    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
-    TclEmitOpcode(		INST_END_CATCH,			envPtr);
-    if (varNameTmp > -1) {
-	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
-    }
-    if (parsePtr->numWords > 3) {
-	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
-    } else {
-	PushLiteral(envPtr, "", 0);
-    }
-    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
-    if (dictVar == -1) {
-	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
-    } else {
-	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
-    }
-    TclEmitOpcode(		INST_RETURN_STK,		envPtr);
-
-    /*
-     * Prepare for the start of the next command.
-     */
-
-    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
-	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
-		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
-    }
-    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 = 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]);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileErrorCmd --
- *
- *	Procedure called to compile the "error" 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 "error" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileErrorCmd(
-    Tcl_Interp *interp,		/* Used for context. */
-    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. */
-{
-    /*
-     * General syntax: [error message ?errorInfo? ?errorCode?]
-     * However, we only deal with the case where there is just a message.
-     */
-    Tcl_Token *messageTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
-
-    if (parsePtr->numWords != 2) {
-	return TCL_ERROR;
-    }
-    messageTokenPtr = TokenAfter(parsePtr->tokenPtr);
-
-    PushLiteral(envPtr, "-code error -level 0", 20);
-    CompileWord(envPtr, messageTokenPtr, interp, 1);
-    TclEmitOpcode(INST_RETURN_STK, envPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclCompileExprCmd --
  *
  *	Procedure called to compile the "expr" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     Tcl_Token *firstWordPtr;
 
+    DefineLineInformation;
+
     if (parsePtr->numWords == 1) {
-	return TCL_ERROR;
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"expr arg ?arg ...?\"", -1);
+        return TCL_ERROR;
     }
 
-    /*
-     * 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;
+    SetLineInformation (1);
+    firstWordPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
+    return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
+	    envPtr);
 }
 
 /*
@@ -1685,33 +516,36 @@ TclCompileExprCmd(
  *	Procedure called to compile the "for" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
     JumpFixup jumpEvalCondFixup;
     int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
-    int bodyRange, nextRange;
+    int bodyRange, nextRange, code;
+    char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
-    DefineLineInformation;	/* TIP #280 */
+
+    DefineLineInformation;
 
     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;
     }
 
@@ -1721,10 +555,11 @@ TclCompileForCmd(
      * execute or execute forever, as in "for {} "$x > 5" {incr x} {}".
      */
 
-    startTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    testTokenPtr = TokenAfter(startTokenPtr);
+    startTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
+    testTokenPtr = startTokenPtr + (startTokenPtr->numComponents + 1);
     if (testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
 
     /*
@@ -1732,30 +567,41 @@ TclCompileForCmd(
      * in order to insure correct behaviour [Bug 219166]
      */
 
-    nextTokenPtr = TokenAfter(testTokenPtr);
-    bodyTokenPtr = TokenAfter(nextTokenPtr);
-    if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
+    nextTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+    bodyTokenPtr = nextTokenPtr + (nextTokenPtr->numComponents + 1);
+    if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) 
 	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
 
     /*
-     * 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).
      */
 
-    bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+    envPtr->exceptDepth++;
+    envPtr->maxExceptDepth =
+	    TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
     nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 
     /*
      * Inline compile the initial command.
      */
 
-    SetLineInformation(1);
-    CompileBody(envPtr, startTokenPtr, interp);
+    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;
+    }
     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).
@@ -1774,23 +620,46 @@ TclCompileForCmd(
      * Compile the loop body.
      */
 
-    bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
-    SetLineInformation(4);
-    CompileBody(envPtr, bodyTokenPtr, interp);
-    ExceptionRangeEnds(envPtr, bodyRange);
+    bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+
+    SetLineInformation (4);
+    code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+	    bodyTokenPtr->numComponents, envPtr);
     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;
-    nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
-    SetLineInformation(3);
-    CompileBody(envPtr, nextTokenPtr, interp);
-    ExceptionRangeEnds(envPtr, nextRange);
+    code = TclCompileCmdWord(interp, nextTokenPtr+1,
+	    nextTokenPtr->numComponents, envPtr);
     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;
 
@@ -1799,7 +668,7 @@ TclCompileForCmd(
      * terminates the for.
      */
 
-    testCodeOffset = CurrentOffset(envPtr);
+    testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
 
     jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
     if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
@@ -1807,22 +676,27 @@ TclCompileForCmd(
 	nextCodeOffset += 3;
 	testCodeOffset += 3;
     }
-
-    SetLineInformation(2);
+    SetLineInformation (2);
     envPtr->currStackDepth = savedStackDepth;
-    TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+    code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+    if (code != TCL_OK) {
+	if (code == TCL_ERROR) {
+	    Tcl_AddObjErrorInfo(interp,
+				"\n    (\"for\" test expression)", -1);
+	}
+	goto done;
+    }
     envPtr->currStackDepth = savedStackDepth + 1;
-
-    jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
+    
+    jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
     if (jumpDist > 127) {
 	TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
     } else {
 	TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
     }
-
+    
     /*
-     * Fix the starting points of the exception ranges (may have moved due to
-     * jump type modification) and set where the exceptions target.
+     * Set the loop's offsets and break target.
      */
 
     envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
@@ -1830,17 +704,21 @@ TclCompileForCmd(
 
     envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;
 
-    ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
-    ExceptionRangeTarget(envPtr, nextRange, breakOffset);
-
+    envPtr->exceptArrayPtr[bodyRange].breakOffset =
+            envPtr->exceptArrayPtr[nextRange].breakOffset =
+	    (envPtr->codeNext - envPtr->codeStart);
+    
     /*
      * The for command's result is an empty string.
      */
 
     envPtr->currStackDepth = savedStackDepth;
-    PushLiteral(envPtr, "", 0);
+    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+    code = TCL_OK;
 
-    return TCL_OK;
+    done:
+    envPtr->exceptDepth--;
+    return code;
 }
 
 /*
@@ -1851,24 +729,27 @@ TclCompileForCmd(
  *	Procedure called to compile the "foreach" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     Proc *procPtr = envPtr->procPtr;
     ForeachInfo *infoPtr;	/* Points to the structure describing this
@@ -1881,19 +762,28 @@ TclCompileForeachCmd(
     Tcl_Token *tokenPtr, *bodyTokenPtr;
     unsigned char *jumpPc;
     JumpFixup jumpFalseFixup;
-    int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex;
+    int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
     int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
+    char buffer[32 + TCL_INTEGER_SPACE];
     int savedStackDepth = envPtr->currStackDepth;
-    DefineLineInformation;	/* TIP #280 */
+
+#ifdef TCL_TIP280
+    int        bodyIndex;
+#endif
 
     /*
      * 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
      */
 
-    int *varcList;
-    const char ***varvList;
+#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;
 
     /*
      * If the foreach command isn't in a procedure, don't compile it inline:
@@ -1901,169 +791,181 @@ TclCompileForeachCmd(
      */
 
     if (procPtr == NULL) {
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
 
     numWords = parsePtr->numWords;
     if ((numWords < 4) || (numWords%2 != 0)) {
-	return TCL_ERROR;
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"foreach varList list ?varList list ...? command\"", -1);
+        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 = TokenAfter(tokenPtr);
+    for (i = 0, tokenPtr = parsePtr->tokenPtr;
+	    i < numWords-1;
+	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
     }
     bodyTokenPtr = tokenPtr;
     if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
-
+#ifdef TCL_TIP280
     bodyIndex = i-1;
+#endif
 
     /*
      * Allocate storage for the varcList and varvList arrays if necessary.
      */
 
     numLists = (numWords - 2)/2;
-    varcList = 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 **));
+    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);
 
     /*
-     * 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 = TokenAfter(tokenPtr)) {
-	Tcl_DString varList;
-
-	if (i%2 != 1) {
-	    continue;
-	}
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    code = TCL_ERROR;
-	    goto done;
-	}
-
-	/*
-	 * Lots of copying going on here. Need a ListObj wizard to show a
-	 * better way.
-	 */
-
-	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]
-	 */
+	    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];
 
-	if (numVars == 0) {
-	    code = TCL_ERROR;
-	    goto done;
-	}
+		/*
+		 * 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]
+		 */
 
-	for (j = 0;  j < numVars;  j++) {
-	    const char *varName = varvList[loopIndex][j];
+		if (numVars == 0) {
+		    code = TCL_OUT_LINE_COMPILE;
+		    goto done;
+		}
 
-	    if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
-		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_OUT_LINE_COMPILE;
+			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, envPtr);
+		/*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
 	if (loopIndex == 0) {
 	    firstValueTemp = tempVar;
 	}
     }
     loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
-	    /*create*/ 1, envPtr);
-
+	    /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
+    
     /*
      * Create and initialize the ForeachInfo and ForeachVarList data
      * structures describing this command. Then create a AuxData record
      * pointing to the ForeachInfo structure.
      */
 
-    infoPtr = ckalloc(sizeof(ForeachInfo)
-	    + numLists * sizeof(ForeachVarList *));
+    infoPtr = (ForeachInfo *) ckalloc((unsigned)
+	    (sizeof(ForeachInfo) + (numLists * sizeof(ForeachVarList *))));
     infoPtr->numLists = numLists;
     infoPtr->firstValueTemp = firstValueTemp;
     infoPtr->loopCtTemp = loopCtTemp;
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
 	ForeachVarList *varListPtr;
-
 	numVars = varcList[loopIndex];
-	varListPtr = ckalloc(sizeof(ForeachVarList)
-		+ numVars * sizeof(int));
+	varListPtr = (ForeachVarList *) ckalloc((unsigned)
+	        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, envPtr);
+		    nameChars, /*create*/ 1, /*flags*/ VAR_SCALAR, procPtr);
 	}
 	infoPtr->varLists[loopIndex] = varListPtr;
     }
-    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);
-
-    /*
-     * Create an exception record to handle [break] and [continue].
-     */
-
-    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
+    infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr);
 
     /*
      * 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 = TokenAfter(tokenPtr)) {
+	    i++, tokenPtr += (tokenPtr->numComponents + 1)) {
 	if ((i%2 == 0) && (i > 0)) {
-	    SetLineInformation(i);
-	    CompileTokens(envPtr, tokenPtr, interp);
+	    SetLineInformation (i);
+	    code = TclCompileTokens(interp, tokenPtr+1,
+		    tokenPtr->numComponents, envPtr);
+	    if (code != TCL_OK) {
+		goto done;
+	    }
+
 	    tempVar = (firstValueTemp + loopIndex);
-	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);
-	    TclEmitOpcode(	INST_POP,			envPtr);
+	    if (tempVar <= 255) {
+		TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
+	    } else {
+		TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
+	    }
+	    TclEmitOpcode(INST_POP, envPtr);
 	    loopIndex++;
 	}
     }
@@ -2072,37 +974,51 @@ TclCompileForeachCmd(
      * Initialize the temporary var that holds the count of loop iterations.
      */
 
-    TclEmitInstInt4(		INST_FOREACH_START4, infoIndex,	envPtr);
-
+    TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);
+    
     /*
      * Top of loop code: assign each loop variable and check whether
      * to terminate the loop.
      */
 
-    ExceptionRangeTarget(envPtr, range, continueOffset);
-    TclEmitInstInt4(		INST_FOREACH_STEP4, infoIndex,	envPtr);
+    envPtr->exceptArrayPtr[range].continueOffset =
+	    (envPtr->codeNext - envPtr->codeStart);
+    TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);
-
+    
     /*
      * Inline compile the loop body.
      */
 
-    SetLineInformation(bodyIndex);
-    ExceptionRangeStarts(envPtr, range);
-    CompileBody(envPtr, bodyTokenPtr, interp);
-    ExceptionRangeEnds(envPtr, range);
+    SetLineInformation (bodyIndex);
+    envPtr->exceptArrayPtr[range].codeOffset =
+	    (envPtr->codeNext - envPtr->codeStart);
+    code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+	    bodyTokenPtr->numComponents, envPtr);
     envPtr->currStackDepth = savedStackDepth + 1;
-    TclEmitOpcode(		INST_POP,			envPtr);
-
+    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 = CurrentOffset(envPtr);
-    jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
+    jumpBackOffset = (envPtr->codeNext - envPtr->codeStart);
+    jumpBackDist =
+	(jumpBackOffset - envPtr->exceptArrayPtr[range].continueOffset);
     if (jumpBackDist > 120) {
 	TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
     } else {
@@ -2113,7 +1029,9 @@ TclCompileForeachCmd(
      * Fix the target of the jump after the foreach_step test.
      */
 
-    if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
+    jumpDist = (envPtr->codeNext - envPtr->codeStart)
+	    - jumpFalseFixup.codeOffset;
+    if (TclFixupForwardJump(envPtr, &jumpFalseFixup, jumpDist, 127)) {
 	/*
 	 * Update the loop body's starting PC offset since it moved down.
 	 */
@@ -2139,24 +1057,28 @@ TclCompileForeachCmd(
      * Set the loop's break target.
      */
 
-    ExceptionRangeTarget(envPtr, range, breakOffset);
-
+    envPtr->exceptArrayPtr[range].breakOffset =
+	    (envPtr->codeNext - envPtr->codeStart);
+    
     /*
      * The foreach command's result is an empty string.
      */
 
     envPtr->currStackDepth = savedStackDepth;
-    PushLiteral(envPtr, "", 0);
+    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
     envPtr->currStackDepth = savedStackDepth + 1;
 
-  done:
+    done:
     for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
-	if (varvList[loopIndex] != NULL) {
-	    ckfree(varvList[loopIndex]);
+	if (varvList[loopIndex] != (CONST char **) NULL) {
+	    ckfree((char *) varvList[loopIndex]);
 	}
     }
-    TclStackFree(interp, (void *)varvList);
-    TclStackFree(interp, varcList);
+    if (varcList != varcListStaticSpace) {
+	ckfree((char *) varcList);
+        ckfree((char *) varvList);
+    }
+    envPtr->exceptDepth--;
     return code;
 }
 
@@ -2165,8 +1087,8 @@ TclCompileForeachCmd(
  *
  * 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
@@ -2174,41 +1096,42 @@ TclCompileForeachCmd(
  *
  * 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)	/* The foreach command's compilation auxiliary
-				 * data to duplicate. */
+DupForeachInfo(clientData)
+    ClientData clientData;	/* The foreach command's compilation
+				 * auxiliary data to duplicate. */
 {
-    register ForeachInfo *srcPtr = clientData;
+    register ForeachInfo *srcPtr = (ForeachInfo *) clientData;
     ForeachInfo *dupPtr;
     register ForeachVarList *srcListPtr, *dupListPtr;
-    int numVars, i, j, numLists = srcPtr->numLists;
-
-    dupPtr = ckalloc(sizeof(ForeachInfo)
-	    + numLists * sizeof(ForeachVarList *));
+    int numLists = srcPtr->numLists;
+    int numVars, i, j;
+    
+    dupPtr = (ForeachInfo *) ckalloc((unsigned)
+	    (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 = ckalloc(sizeof(ForeachVarList)
-		+ numVars * sizeof(int));
+	dupListPtr = (ForeachVarList *) ckalloc((unsigned)
+	        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 dupPtr;
+    return (ClientData) dupPtr;
 }
 
 /*
@@ -2231,152 +1154,20 @@ DupForeachInfo(
  */
 
 static void
-FreeForeachInfo(
-    ClientData clientData)	/* The foreach command's compilation auxiliary
-				 * data to free. */
+FreeForeachInfo(clientData)
+    ClientData clientData;	/* The foreach command's compilation
+				 * auxiliary data to free. */
 {
-    register ForeachInfo *infoPtr = clientData;
+    register ForeachInfo *infoPtr = (ForeachInfo *) clientData;
     register ForeachVarList *listPtr;
     int numLists = infoPtr->numLists;
     register int i;
 
     for (i = 0;  i < numLists;  i++) {
 	listPtr = infoPtr->varLists[i];
-	ckfree(listPtr);
-    }
-    ckfree(infoPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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);
+	ckfree((char *) listPtr);
     }
-
-    /*
-     * Pop the namespace, and set the result to empty
-     */
-
-    TclEmitOpcode(		INST_POP,			envPtr);
-    PushLiteral(envPtr, "", 0);
-    return TCL_OK;
+    ckfree((char *) infoPtr);
 }
 
 /*
@@ -2387,49 +1178,53 @@ TclCompileGlobalCmd(
  *	Procedure called to compile the "if" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     JumpFixupArray jumpFalseFixupArray;
-				/* Used to fix the ifFalse jump after each
+    				/* 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 jumpIndex = 0;		/* Avoid compiler warning. */
-    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
-    const char *word;
+    int jumpDist, jumpFalseDist;
+    int jumpIndex = 0;          /* avoid compiler warning. */
+    int numWords, wordIdx, numBytes, j, code;
+    CONST char *word;
+    char buffer[100];
     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;	/* TIP #280 */
+    int realCond = 1;           /* set to 0 for static conditions: "if 0 {..}" */
+    int boolVal;                /* value of static condition */
+    int compileScripts = 1;            
+
+    DefineLineInformation;
 
     /*
-     * 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;
@@ -2438,18 +1233,19 @@ TclCompileIfCmd(
 
     for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    return TCL_ERROR;
+	    return TCL_OUT_LINE_COMPILE;
 	}
-	tokenPtr = TokenAfter(tokenPtr);
+	tokenPtr += 2;
     }
 
+
     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;
@@ -2462,67 +1258,84 @@ TclCompileIfCmd(
 	word = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
 	if ((tokenPtr == parsePtr->tokenPtr)
-		|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
-	    tokenPtr = TokenAfter(tokenPtr);
+	        || ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
+	    tokenPtr += (tokenPtr->numComponents + 1);
 	    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);
-	    TclDecrRefCount(boolObj);
+	    Tcl_DecrRefCount(boolObj);
 	    if (code == TCL_OK) {
 		/*
-		 * A static condition.
+		 * A static condition
 		 */
-
 		realCond = 0;
 		if (!boolVal) {
 		    compileScripts = 0;
 		}
 	    } else {
-		SetLineInformation(wordIdx);
 		Tcl_ResetResult(interp);
-		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+		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;
+		}
 		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 = TokenAfter(testTokenPtr);
+	tokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
 	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;
 	}
@@ -2530,9 +1343,12 @@ TclCompileIfCmd(
 	    word = tokenPtr[1].start;
 	    numBytes = tokenPtr[1].size;
 	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
-		tokenPtr = TokenAfter(tokenPtr);
+		tokenPtr += (tokenPtr->numComponents + 1);
 		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;
 		}
@@ -2544,74 +1360,87 @@ TclCompileIfCmd(
 	 */
 
 	if (compileScripts) {
-	    SetLineInformation(wordIdx);
+	    SetLineInformation (wordIdx);
 	    envPtr->currStackDepth = savedStackDepth;
-	    CompileBody(envPtr, tokenPtr, interp);
+	    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;
+	    }	
 	}
 
 	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.
 	     */
 
-	    if (TclFixupForwardJumpToHere(envPtr,
-		    jumpFalseFixupArray.fixup+jumpIndex, 120)) {
+	    jumpDist = (envPtr->codeNext - envPtr->codeStart)
+	            - jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
+	    if (TclFixupForwardJump(envPtr,
+	            &(jumpFalseFixupArray.fixup[jumpIndex]), jumpDist, 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 = TokenAfter(tokenPtr);
+	tokenPtr += (tokenPtr->numComponents + 1);
 	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.
 	 */
@@ -2619,9 +1448,12 @@ TclCompileIfCmd(
 	word = tokenPtr[1].start;
 	numBytes = tokenPtr[1].size;
 	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
-	    tokenPtr = TokenAfter(tokenPtr);
+	    tokenPtr += (tokenPtr->numComponents + 1);
 	    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;
 	    }
@@ -2631,17 +1463,28 @@ TclCompileIfCmd(
 	    /*
 	     * Compile the else command body.
 	     */
-
-	    SetLineInformation(wordIdx);
-	    CompileBody(envPtr, tokenPtr, interp);
+	    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;
+	    }
 	}
 
 	/*
 	 * 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;
 	}
@@ -2651,27 +1494,28 @@ TclCompileIfCmd(
 	 */
 
 	if (compileScripts) {
-	    PushLiteral(envPtr, "", 0);
+	    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
 	}
     }
 
     /*
      * 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. */
-	if (TclFixupForwardJumpToHere(envPtr,
-		jumpEndFixupArray.fixup+jumpIndex, 127)) {
+	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)) {
 	    /*
-	     * 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;
@@ -2681,7 +1525,7 @@ TclCompileIfCmd(
 		jumpFalseDist += 3;
 		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
 	    } else {
-		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
+		panic("TclCompileIfCmd: unexpected opcode updating ifFalse jump");
 	    }
 	}
     }
@@ -2690,7 +1534,7 @@ TclCompileIfCmd(
      * Free the jumpFixupArray array if malloc'ed storage was used.
      */
 
-  done:
+    done:
     envPtr->currStackDepth = savedStackDepth + 1;
     TclFreeJumpFixupArray(&jumpFalseFixupArray);
     TclFreeJumpFixupArray(&jumpEndFixupArray);
@@ -2705,37 +1549,50 @@ TclCompileIfCmd(
  *	Procedure called to compile the "incr" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     Tcl_Token *varTokenPtr, *incrTokenPtr;
     int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
-    DefineLineInformation;	/* TIP #280 */
+    int code = TCL_OK;
+
+    DefineLineInformation;
 
     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 = TokenAfter(parsePtr->tokenPtr);
+    varTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
 
-    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
+    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, 
+	    (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
 	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (code != TCL_OK) {
+	goto done;
+    }
 
     /*
      * If an increment is given, push it, but see first if it's a small
@@ -2745,143 +1602,90 @@ TclCompileIncrCmd(
     haveImmValue = 0;
     immValue = 1;
     if (parsePtr->numWords == 3) {
-	incrTokenPtr = TokenAfter(varTokenPtr);
+	incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
 	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    const char *word = incrTokenPtr[1].start;
+	    CONST char *word = incrTokenPtr[1].start;
 	    int numBytes = incrTokenPtr[1].size;
-	    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;
+
+	    /*
+	     * 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;
+		}
 	    }
 	    if (!haveImmValue) {
-		PushLiteral(envPtr, word, numBytes);
+		TclEmitPush(
+			TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
 	    }
 	} else {
-	    SetLineInformation(2);
-	    CompileTokens(envPtr, incrTokenPtr, interp);
+	    SetLineInformation (2);
+	    code = TclCompileTokens(interp, incrTokenPtr+1, 
+	            incrTokenPtr->numComponents, envPtr);
+	    if (code != TCL_OK) {
+		goto done;
+	    }
 	}
-    } 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.
      */
 
-    if (!simpleVarName) {
-	if (haveImmValue) {
-	    TclEmitInstInt1(	INST_INCR_STK_IMM, immValue,	envPtr);
-	} else {
-	    TclEmitOpcode(	INST_INCR_STK,			envPtr);
-	}
-    } else if (isScalar) {	/* Simple scalar variable. */
-	if (localIndex >= 0) {
-	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
-		TclEmitInt1(immValue, envPtr);
-	    } else {
-		TclEmitInstInt1(INST_INCR_SCALAR1, localIndex,	envPtr);
-	    }
-	} else {
-	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
-	    } else {
-		TclEmitOpcode(	INST_INCR_SCALAR_STK,		envPtr);
-	    }
-	}
-    } else {			/* Simple array variable. */
-	if (localIndex >= 0) {
-	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
-		TclEmitInt1(immValue, envPtr);
+    if (simpleVarName) {
+	if (isScalar) {
+	    if (localIndex >= 0) {
+		if (haveImmValue) {
+		    TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
+		    TclEmitInt1(immValue, envPtr);
+		} else {
+		    TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
+		}
 	    } else {
-		TclEmitInstInt1(INST_INCR_ARRAY1, localIndex,	envPtr);
+		if (haveImmValue) {
+		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
+		} else {
+		    TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
+		}
 	    }
 	} else {
-	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
+	    if (localIndex >= 0) {
+		if (haveImmValue) {
+		    TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
+		    TclEmitInt1(immValue, envPtr);
+		} else {
+		    TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
+		}
 	    } else {
-		TclEmitOpcode(	INST_INCR_ARRAY_STK,		envPtr);
+		if (haveImmValue) {
+		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
+		} else {
+		    TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
+		}
 	    }
 	}
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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, 0, &localIndex,
-	    &simpleVarName, &isScalar, 1);
-
-    /*
-     * Emit instruction to check the variable for existence.
-     */
-
-    if (!simpleVarName) {
-	TclEmitOpcode(		INST_EXIST_STK,			envPtr);
-    } else 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 {			/* non-simple variable name */
+	if (haveImmValue) {
+	    TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
 	} else {
-	    TclEmitInstInt4(	INST_EXIST_ARRAY, localIndex,	envPtr);
+	    TclEmitOpcode(INST_INCR_STK, envPtr);
 	}
     }
-
-    return TCL_OK;
+	
+    done:
+    return code;
 }
 
 /*
@@ -2892,47 +1696,53 @@ TclCompileInfoExistsCmd(
  *	Procedure called to compile the "lappend" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
-    Tcl_Token *varTokenPtr;
+    Tcl_Token *varTokenPtr, *valueTokenPtr;
     int simpleVarName, isScalar, localIndex, numWords;
-    DefineLineInformation;	/* TIP #280 */
+    int code = TCL_OK;
+
+    DefineLineInformation;
 
     /*
      * If we're not in a procedure, don't compile.
      */
-
     if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
 
     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_ERROR;
+        return TCL_OUT_LINE_COMPILE;
     }
 
     /*
@@ -2940,23 +1750,36 @@ TclCompileLappendCmd(
      * 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 = TokenAfter(parsePtr->tokenPtr);
+    varTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
 
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
+    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
 	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (code != TCL_OK) {
+	goto done;
+    }
 
     /*
-     * 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) {
-	Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
-
-	CompileWord(envPtr, valueTokenPtr, interp, 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;
+	    }
+	}
     }
 
     /*
@@ -2967,133 +1790,34 @@ TclCompileLappendCmd(
      * The *_STK opcodes should be refactored to make better use of existing
      * LOAD/STORE instructions.
      */
-
-    if (!simpleVarName) {
-	TclEmitOpcode(		INST_LAPPEND_STK,		envPtr);
-    } else if (isScalar) {
-	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LAPPEND_STK,		envPtr);
-	} else {
-	    Emit14Inst(		INST_LAPPEND_SCALAR, localIndex, envPtr);
-	}
-    } else {
-	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LAPPEND_ARRAY_STK,		envPtr);
-	} else {
-	    Emit14Inst(		INST_LAPPEND_ARRAY, localIndex,	envPtr);
-	}
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLassignCmd --
- *
- *	Procedure called to compile the "lassign" 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 "lassign" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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 *tokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords, idx;
-    DefineLineInformation;	/* TIP #280 */
-
-    numWords = parsePtr->numWords;
-
-    /*
-     * Check for command syntax error, but we'll punt that to runtime.
-     */
-
-    if (numWords < 3) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Generate code to push list being taken apart by [lassign].
-     */
-
-    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, 0, &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) {
-	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
-	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
-	    TclEmitOpcode(	INST_STORE_STK,			envPtr);
-	    TclEmitOpcode(	INST_POP,			envPtr);
-	} else if (isScalar) {
+    if (simpleVarName) {
+	if (isScalar) {
 	    if (localIndex >= 0) {
-		TclEmitOpcode(	INST_DUP,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
-		Emit14Inst(	INST_STORE_SCALAR, localIndex,	envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		if (localIndex <= 255) {
+		    TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
+		} else {
+		    TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
+		}
 	    } else {
-		TclEmitInstInt4(INST_OVER, 1,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
-		TclEmitOpcode(	INST_STORE_SCALAR_STK,		envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		TclEmitOpcode(INST_LAPPEND_STK, envPtr);
 	    }
 	} else {
 	    if (localIndex >= 0) {
-		TclEmitInstInt4(INST_OVER, 1,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
-		Emit14Inst(	INST_STORE_ARRAY, localIndex,	envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		if (localIndex <= 255) {
+		    TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
+		} else {
+		    TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
+		}
 	    } else {
-		TclEmitInstInt4(INST_OVER, 2,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
-		TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
 	    }
 	}
+    } else {
+	TclEmitOpcode(INST_LAPPEND_STK, envPtr);
     }
 
-    /*
-     * Generate code to leave the rest of the list on the stack.
-     */
-
-    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
-    TclEmitInt4(		-2 /* == "end" */,		envPtr);
-
-    return TCL_OK;
+    done:
+    return code;
 }
 
 /*
@@ -3104,101 +1828,74 @@ TclCompileLassignCmd(
  *	Procedure called to compile the "lindex" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "lindex" command at
- *	runtime.
+ *	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. */
+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. */
 {
-    Tcl_Token *idxTokenPtr, *valTokenPtr;
-    int i, numWords = parsePtr->numWords;
-    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varTokenPtr;
+    int code, i;
+    int numWords;
+
+    DefineLineInformation;
+
+    numWords = parsePtr->numWords;
 
     /*
-     * Quit if too few args.
+     * 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);
-	if (result == TCL_OK) {
-	    if (idx < 0) {
-		result = TCL_ERROR;
-	    }
-	} else {
-	    result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
-	    if (result == TCL_OK && idx > -2) {
-		result = TCL_ERROR;
-	    }
-	}
-	TclDecrRefCount(tmpObj);
-
-	if (result == TCL_OK) {
-	    /*
-	     * All checks have been completed, and we have exactly one of
-	     * these constructs:
-	     *	 lindex <arbitraryValue> <posInt>
-	     *	 lindex <arbitraryValue> end-<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.
-	 */
+    if ( numWords <= 1 ) {
+	return TCL_OUT_LINE_COMPILE;
     }
 
+    varTokenPtr = parsePtr->tokenPtr
+	+ (parsePtr->tokenPtr->numComponents + 1);
+    
     /*
      * Push the operands onto the stack.
      */
-
-  emitComplexLindex:
-    for (i=1 ; i<numWords ; i++) {
-	CompileWord(envPtr, valTokenPtr, interp, i);
-	valTokenPtr = TokenAfter(valTokenPtr);
+	
+    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;
+	    }
+	}
+	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
     }
-
+	
     /*
-     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
-     * multiple index args.
+     * 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);
+    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;
@@ -3212,55 +1909,69 @@ TclCompileLindexCmd(
  *	Procedure called to compile the "list" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
-    DefineLineInformation;	/* TIP #280 */
-    Tcl_Token *valueTokenPtr;
-    int i, numWords;
+    DefineLineInformation;
 
     /*
      * If we're not in a procedure, don't compile.
      */
-
     if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
 
     if (parsePtr->numWords == 1) {
 	/*
-	 * [list] without arguments just pushes an empty object.
+	 * Empty args case
 	 */
 
-	PushLiteral(envPtr, "", 0);
+	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
     } else {
 	/*
 	 * Push the all values onto the stack.
 	 */
+	Tcl_Token *valueTokenPtr;
+	int i, code, numWords;
 
 	numWords = parsePtr->numWords;
-	valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
+
+	valueTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
 	for (i = 1; i < numWords; i++) {
-	    CompileWord(envPtr, valueTokenPtr, interp, i);
-	    valueTokenPtr = TokenAfter(valueTokenPtr);
+	    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);
 	}
-	TclEmitInstInt4(	INST_LIST, numWords - 1,	envPtr);
+	TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
     }
 
     return TCL_OK;
@@ -3274,424 +1985,454 @@ TclCompileListCmd(
  *	Procedure called to compile the "llength" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
     Tcl_Token *varTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
+    int code;
+
+    DefineLineInformation;
 
     if (parsePtr->numWords != 2) {
+	Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
+		TCL_STATIC);
 	return TCL_ERROR;
     }
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    varTokenPtr = parsePtr->tokenPtr
+	+ (parsePtr->tokenPtr->numComponents + 1);
 
-    CompileWord(envPtr, varTokenPtr, interp, 1);
-    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+    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;
+	}
+    }
+    TclEmitOpcode(INST_LIST_LENGTH, envPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLrangeCmd --
+ * TclCompileLsetCmd --
  *
- *	How to compile the "lrange" command. We only bother because we needed
- *	the opcode anyway for "lassign".
+ *	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.
+ *
+ * Side effects:
+ *	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.
+ *	(6) At this point, the stack contains:
+ *	     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.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileLrangeCmd(
-    Tcl_Interp *interp,		/* Tcl interpreter for context. */
-    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. */
+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 */
 {
-    Tcl_Token *tokenPtr, *listTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
-    Tcl_Obj *tmpObj;
-    int idx1, idx2, result;
 
-    if (parsePtr->numWords != 4) {
-	return TCL_ERROR;
+    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 i;
+
+    DefineLineInformation;
+
+    /* Check argument count */
+
+    if ( parsePtr->numWords < 3 ) {
+	/* Fail at run time, not in compilation */
+	return TCL_OUT_LINE_COMPILE;
     }
-    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     /*
-     * Parse the first index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * 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(listTokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx1);
-    if (result == TCL_OK) {
-	if (idx1 < 0) {
-	    result = TCL_ERROR;
-	}
-    } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
-	if (result == TCL_OK && idx1 > -2) {
-	    result = TCL_ERROR;
-	}
-    }
-    TclDecrRefCount(tmpObj);
+    varTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
+    result = TclPushVarNameWord( interp, varTokenPtr, envPtr, 
+            TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar, 1);
     if (result != TCL_OK) {
-	return TCL_ERROR;
+	return result;
     }
 
-    /*
-     * Parse the second index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
-     */
+    /* Push the "index" args and the new element value. */
 
-    tokenPtr = TokenAfter(tokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx2);
-    if (result == TCL_OK) {
-	if (idx2 < 0) {
-	    result = TCL_ERROR;
-	}
-    } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
-	if (result == TCL_OK && idx2 > -2) {
-	    result = TCL_ERROR;
+    for ( i = 2; i < parsePtr->numWords; ++i ) {
+
+	/* Advance to next arg */
+
+	varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+
+	/* Push an arg */
+
+	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;
+	    }
 	}
     }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
 
     /*
-     * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
-     * we've not proved that the 'list' argument is really a list. Not that it
-     * is worth trying to do that given current knowledge.
+     * Duplicate the variable name if it's been pushed.  
      */
 
-    CompileWord(envPtr, listTokenPtr, interp, 1);
-    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
-    TclEmitInt4(		idx2,				envPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileLreplaceCmd --
- *
- *	How to compile the "lreplace" command. We only bother with the case
- *	where there are no elements to insert and where both the 'first' and
- *	'last' arguments are constant and one can be deterined to be at the
- *	end of the list. (This is the case that could also be written with
- *	"lrange".)
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileLreplaceCmd(
-    Tcl_Interp *interp,		/* Tcl interpreter for context. */
-    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 *tokenPtr, *listTokenPtr;
-    DefineLineInformation;	/* TIP #280 */
-    Tcl_Obj *tmpObj;
-    int idx1, idx2, result, guaranteedDropAll = 0;
-
-    if (parsePtr->numWords != 4) {
-	return TCL_ERROR;
+    if ( !simpleVarName || localIndex < 0 ) {
+	if ( !simpleVarName || isScalar ) {
+	    tempDepth = parsePtr->numWords - 2;
+	} else {
+	    tempDepth = parsePtr->numWords - 1;
+	}
+	TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
     }
-    listTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     /*
-     * Parse the first index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * Duplicate an array index if one's been pushed
      */
 
-    tokenPtr = TokenAfter(listTokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx1);
-    if (result == TCL_OK) {
-	if (idx1 < 0) {
-	    result = TCL_ERROR;
-	}
-    } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
-	if (result == TCL_OK && idx1 > -2) {
-	    result = TCL_ERROR;
+    if ( simpleVarName && !isScalar ) {
+	if ( localIndex < 0 ) {
+	    tempDepth = parsePtr->numWords - 1;
+	} else {
+	    tempDepth = parsePtr->numWords - 2;
 	}
-    }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
+	TclEmitInstInt4( INST_OVER, tempDepth, envPtr );
     }
 
     /*
-     * Parse the second index. Will only compile if it is constant and not an
-     * _integer_ less than zero (since we reserve negative indices here for
-     * end-relative indexing).
+     * Emit code to load the variable's value.
      */
 
-    tokenPtr = TokenAfter(tokenPtr);
-    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	return TCL_ERROR;
-    }
-    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
-    result = TclGetIntFromObj(NULL, tmpObj, &idx2);
-    if (result == TCL_OK) {
-	if (idx2 < 0) {
-	    result = TCL_ERROR;
+    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 );
 	}
     } else {
-	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
-	if (result == TCL_OK && idx2 > -2) {
-	    result = TCL_ERROR;
+	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 );
 	}
     }
-    TclDecrRefCount(tmpObj);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
 
     /*
-     * Sanity check: can only issue when we're removing a range at one or
-     * other end of the list. If we're at one end or the other, convert the
-     * indices into the equivalent for an [lrange].
+     * Emit the correct variety of 'lset' instruction
      */
 
-    if (idx1 == 0) {
-	if (idx2 == -2) {
-	    guaranteedDropAll = 1;
-	}
-	idx1 = idx2 + 1;
-	idx2 = -2;
-    } else if (idx2 == -2) {
-	idx2 = idx1 - 1;
-	idx1 = 0;
+    if ( parsePtr->numWords == 4 ) {
+	TclEmitOpcode( INST_LSET_LIST, envPtr );
     } else {
-	return TCL_ERROR;
+	TclEmitInstInt4( INST_LSET_FLAT, (parsePtr->numWords - 1), envPtr );
     }
 
     /*
-     * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
-     * we've not proved that the 'list' argument is really a list. Not that it
-     * is worth trying to do that given current knowledge.
+     * Emit code to put the value back in the variable
      */
 
-    CompileWord(envPtr, listTokenPtr, interp, 1);
-    if (guaranteedDropAll) {
-	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
-	TclEmitOpcode(		INST_POP,			envPtr);
-	PushLiteral(envPtr, "", 0);
+    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 );
+	}
     } else {
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx1,	envPtr);
-	TclEmitInt4(		idx2,				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 );
+	}
     }
+    
     return TCL_OK;
+
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileLsetCmd --
+ * TclCompileRegexpCmd --
  *
- *	Procedure called to compile the "lset" command.
+ *	Procedure called to compile the "regexp" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * Side effects:
- *	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.
- *	(6) At this point, the stack contains:
- *		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.
+ *	Instructions are added to envPtr to execute the "regexp" command
+ *	at runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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. */
+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 */
 {
-    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 */
+    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing
+				 * the parse of the RE or string */
+    int i, len, code, nocase, anchorLeft, anchorRight, start;
+    char *str;
+
+    DefineLineInformation;
 
     /*
-     * Check argument count.
+     * 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) {
-	/*
-	 * Fail at run time, not in compilation.
-	 */
-
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
 
+    nocase = 0;
+    varTokenPtr = parsePtr->tokenPtr;
+
     /*
-     * 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.
+     * 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);
+	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+	    /* Not a simple string - punt to runtime. */
+	    return TCL_OUT_LINE_COMPILE;
+	}
+	str = (char *) varTokenPtr[1].start;
+	len = varTokenPtr[1].size;
+	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
+	    i++;
+	    break;
+	} else if ((len > 1)
+		&& (strncmp(str, "-nocase", (unsigned) len) == 0)) {
+	    nocase = 1;
+	} else {
+	    /* Not an option we recognize. */
+	    return TCL_OUT_LINE_COMPILE;
+	}
+    }
 
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-	    &localIndex, &simpleVarName, &isScalar, 1);
+    if ((parsePtr->numWords - i) != 2) {
+	/* We don't support capturing to variables */
+	return TCL_OUT_LINE_COMPILE;
+    }
 
     /*
-     * Push the "index" args and the new element value.
+     * 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.
      */
+    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;
+    }
 
-    for (i=2 ; i<parsePtr->numWords ; ++i) {
-	varTokenPtr = TokenAfter(varTokenPtr);
-	CompileWord(envPtr, varTokenPtr, interp, i);
+    if (len == 0) {
+	/*
+	 * The semantics of regexp are always match on re == "".
+	 */
+	TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
+	return TCL_OK;
     }
 
     /*
-     * Duplicate the variable name if it's been pushed.
+     * 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;
 
-    if (!simpleVarName || localIndex < 0) {
-	if (!simpleVarName || isScalar) {
-	    tempDepth = parsePtr->numWords - 2;
-	} else {
-	    tempDepth = parsePtr->numWords - 1;
-	}
-	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
+    /*
+     * 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;
     }
 
     /*
-     * Duplicate an array index if one's been pushed.
+     * 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 (simpleVarName && !isScalar) {
-	if (localIndex < 0) {
-	    tempDepth = parsePtr->numWords - 1;
-	} else {
-	    tempDepth = parsePtr->numWords - 2;
-	}
-	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
+    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;
     }
 
     /*
-     * Emit code to load the variable's value.
+     * 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;
+    }
 
-    if (!simpleVarName) {
-	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
-    } else if (isScalar) {
-	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LOAD_SCALAR_STK,		envPtr);
-	} else {
-	    Emit14Inst(		INST_LOAD_SCALAR, localIndex,	envPtr);
-	}
+    if (anchorLeft && anchorRight) {
+	TclEmitPush(TclRegisterNewLiteral(envPtr, str+start, len-start),
+		envPtr);
     } else {
-	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LOAD_ARRAY_STK,		envPtr);
+	/*
+	 * This needs to find the substring anywhere in the string, so
+	 * use string match and *foo*, with appropriate anchoring.
+	 */
+	char *newStr  = ckalloc((unsigned) len + 3);
+	len -= start;
+	if (anchorLeft) {
+	    strncpy(newStr, str + start, (size_t) len);
 	} else {
-	    Emit14Inst(		INST_LOAD_ARRAY, localIndex,	envPtr);
+	    newStr[0] = '*';
+	    strncpy(newStr + 1, str + start, (size_t) len++);
+	}
+	if (!anchorRight) {
+	    newStr[len++] = '*';
 	}
+	newStr[len] = '\0';
+	TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len), envPtr);
+	ckfree((char *) newStr);
     }
+    ckfree((char *) str);
 
     /*
-     * Emit the correct variety of 'lset' instruction.
+     * Push the string arg
      */
-
-    if (parsePtr->numWords == 4) {
-	TclEmitOpcode(		INST_LSET_LIST,			envPtr);
+    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
+    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+	TclEmitPush(TclRegisterNewLiteral(envPtr,
+		varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
     } else {
-	TclEmitInstInt4(	INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
+	SetLineInformation (parsePtr->numWords-1);
+	code = TclCompileTokens(interp, varTokenPtr+1,
+		varTokenPtr->numComponents, envPtr);
+	if (code != TCL_OK) {
+	    return code;
+	}
     }
 
-    /*
-     * 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 {
-	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
-	}
+    if (anchorLeft && anchorRight && !nocase) {
+	TclEmitOpcode(INST_STR_EQ, envPtr);
     } else {
-	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
-	} else {
-	    Emit14Inst(		INST_STORE_ARRAY, localIndex,	envPtr);
-	}
+	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
     }
 
     return TCL_OK;
@@ -3700,777 +2441,823 @@ TclCompileLsetCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileNamespaceCmd --
+ * TclCompileReturnCmd --
  *
- *	Procedure called to compile the "namespace" command; currently, only
- *	the subcommand "namespace upvar" is compiled to bytecodes, and then
- *	only inside a procedure(-like) context.
+ *	Procedure called to compile the "return" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "namespace upvar"
- *	command at runtime.
+ *	Instructions are added to envPtr to execute the "return" command
+ *	at runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclCompileNamespaceUpvarCmd(
-    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. */
+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. */
 {
-    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varTokenPtr;
+    int code;
+    int index = envPtr->exceptArrayNext - 1;
 
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
+    DefineLineInformation;
 
     /*
-     * Only compile [namespace upvar ...]: needs an even number of args, >=4
+     * If we're not in a procedure, don't compile.
      */
 
-    numWords = parsePtr->numWords;
-    if ((numWords % 2) || (numWords < 4)) {
-	return TCL_ERROR;
+    if (envPtr->procPtr == NULL) {
+	return TCL_OUT_LINE_COMPILE;
     }
 
     /*
-     * Push the namespace
+     * 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.
      */
 
-    tokenPtr = TokenAfter(parsePtr->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=3; i<=numWords; i+=2) {
-	otherTokenPtr = TokenAfter(localTokenPtr);
-	localTokenPtr = TokenAfter(otherTokenPtr);
-
-	CompileWord(envPtr, otherTokenPtr, interp, 1);
-	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
-		&localIndex, &simpleVarName, &isScalar, 1);
+    while (index >= 0) {
+	ExceptionRange range = envPtr->exceptArrayPtr[index];
+	if ((range.type == CATCH_EXCEPTION_RANGE) 
+		&& (range.catchOffset == -1)) {
+	    return TCL_OUT_LINE_COMPILE;
+	}
+	index--;
+    }
 
-	if ((localIndex < 0) || !isScalar) {
-	    return TCL_ERROR;
+    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;
+		}
+	    }
+	    break;
+	}
+	default: {
+	    /*
+	     * Most complex return cases: everything else, including
+	     * [return -code error], etc.
+	     */
+	    return TCL_OUT_LINE_COMPILE;
 	}
-	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
     }
 
     /*
-     * Pop the namespace, and set the result to empty
+     * 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).
      */
-
-    TclEmitOpcode(		INST_POP,			envPtr);
-    PushLiteral(envPtr, "", 0);
+    TclEmitOpcode(INST_DONE, envPtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileRegexpCmd --
+ * TclCompileSetCmd --
  *
- *	Procedure called to compile the "regexp" command.
+ *	Procedure called to compile the "set" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "regexp" command at
- *	runtime.
+ *	Instructions are added to envPtr to execute the "set" command
+ *	at runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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. */
+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. */
 {
-    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
-				 * parse of the RE or string. */
-    int i, len, nocase, exact, sawLast, simple;
-    const char *str;
-    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *varTokenPtr, *valueTokenPtr;
+    int isAssignment, isScalar, simpleVarName, localIndex, numWords;
+    int code = TCL_OK;
 
-    /*
-     * We are only interested in compiling simple regexp cases. Currently
-     * supported compile cases are:
-     *   regexp ?-nocase? ?--? staticString $var
-     *   regexp ?-nocase? ?--? {^staticString$} $var
-     */
+    DefineLineInformation;
 
-    if (parsePtr->numWords < 3) {
-	return TCL_ERROR;
+    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;
     }
-
-    simple = 0;
-    nocase = 0;
-    sawLast = 0;
-    varTokenPtr = parsePtr->tokenPtr;
+    isAssignment = (numWords == 3);
 
     /*
-     * 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.
+     * 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. 
      */
 
-    for (i = 1; i < parsePtr->numWords - 2; i++) {
-	varTokenPtr = TokenAfter(varTokenPtr);
-	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    /*
-	     * Not a simple string, so punt to runtime.
-	     */
-
-	    return TCL_ERROR;
-	}
-	str = 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)) {
-	    nocase = 1;
-	} else {
-	    /*
-	     * Not an option we recognize.
-	     */
-
-	    return TCL_ERROR;
-	}
-    }
-
-    if ((parsePtr->numWords - i) != 2) {
-	/*
-	 * We don't support capturing to variables.
-	 */
+    varTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
 
-	return TCL_ERROR;
+    code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+	    &localIndex, &simpleVarName, &isScalar, 1);
+    if (code != TCL_OK) {
+	goto done;
     }
 
     /*
-     * 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.
+     * If we are doing an assignment, push the new value.
      */
 
-    varTokenPtr = TokenAfter(varTokenPtr);
-
-    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	Tcl_DString ds;
-
-	str = varTokenPtr[1].start;
-	len = varTokenPtr[1].size;
-
-	/*
-	 * If it has a '-', it could be an incorrectly formed regexp command.
-	 */
-
-	if ((*str == '-') && !sawLast) {
-	    return TCL_ERROR;
-	}
-
-	if (len == 0) {
-	    /*
-	     * The semantics of regexp are always match on re == "".
-	     */
-
-	    PushLiteral(envPtr, "1", 1);
-	    return TCL_OK;
-	}
-
-	/*
-	 * Attempt to convert pattern to glob.  If successful, push the
-	 * converted pattern as a literal.
-	 */
-
-	if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
-		== TCL_OK) {
-	    simple = 1;
-	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
-	    Tcl_DStringFree(&ds);
+    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;
+	    }
 	}
     }
 
-    if (!simple) {
-	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
-    }
-
     /*
-     * Push the string arg.
+     * Emit instructions to set/get the variable.
      */
 
-    varTokenPtr = TokenAfter(varTokenPtr);
-    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
-
-    if (simple) {
-	if (exact && !nocase) {
-	    TclEmitOpcode(	INST_STR_EQ,			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 {
+		TclEmitOpcode((isAssignment?
+		        INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
+	    }
 	} else {
-	    TclEmitInstInt1(	INST_STR_MATCH, nocase,		envPtr);
+	    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 {
+		TclEmitOpcode((isAssignment?
+		        INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), 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.
-	 */
-
-	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
-
-	TclEmitInstInt1(	INST_REGEXP, cflags,		envPtr);
+	TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
     }
-
-    return TCL_OK;
+	
+    done:
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileReturnCmd --
+ * TclCompileStringCmd --
  *
- *	Procedure called to compile the "return" command.
+ *	Procedure called to compile the "string" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "return" command at
- *	runtime.
+ *	Instructions are added to envPtr to execute the "string" command
+ *	at runtime.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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. */
+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. */
 {
-    /*
-     * 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 */
-
-    /*
-     * 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 ((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);
+    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;
+
+    if (parsePtr->numWords < 2) {
+	/* Fail at run time, not in compilation */
+	return TCL_OUT_LINE_COMPILE;
+    }
+    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:
+	    /*
+	     * All other cases: compile out of line.
+	     */
+	    return TCL_OUT_LINE_COMPILE;
 
-	CompileWord(envPtr, optsTokenPtr, interp, 2);
-	CompileWord(envPtr, msgTokenPtr,  interp, 3);
-	TclEmitOpcode(INST_RETURN_STK, envPtr);
-	return TCL_OK;
-    }
+	case STR_COMPARE: 
+	case STR_EQUAL: {
+	    int 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.
+	     */
 
-    /*
-     * Allocate some working space.
-     */
+	    if (parsePtr->numWords != 4) {
+		return TCL_OUT_LINE_COMPILE;
+	    }
 
-    objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));
+	    /*
+	     * Push the two operands onto the stack.
+	     */
 
-    /*
-     * 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.
-     */
+	    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);
+	    }
 
-    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;
+	    TclEmitOpcode(((((enum options) index) == STR_COMPARE) ?
+		    INST_STR_CMP : INST_STR_EQ), envPtr);
+	    return TCL_OK;
 	}
-	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.
-	 */
+	case STR_INDEX: {
+	    int i;
 
-	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 (parsePtr->numWords != 4) {
+		/* Fail at run time, not in compilation */
+		return TCL_OUT_LINE_COMPILE;
+	    }
 
-    if (explicitResult) {
-	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
-    } else {
-	/*
-	 * No explict result argument, so default result is empty string.
-	 */
+	    /*
+	     * Push the two operands onto the stack.
+	     */
 
-	PushLiteral(envPtr, "", 0);
-    }
+	    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);
+	    }
 
-    /*
-     * 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.
-     */
+	    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;
+	    }
 
-    if (numOptionWords == 0 && envPtr->procPtr != NULL) {
-	/*
-	 * We have default return options and we're in a proc ...
-	 */
+	    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.
+		 */
+		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;
+		}
+	    }
+	    TclEmitOpcode(INST_STR_LEN, envPtr);
+	    return TCL_OK;
+	}
+	case STR_MATCH: {
+	    int i, length, exactMatch = 0, nocase = 0;
+	    CONST char *str;
 
-	int index = envPtr->exceptArrayNext - 1;
-	int enclosingCatch = 0;
+	    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
+		/* Fail at run time, not in compilation */
+		return TCL_OUT_LINE_COMPILE;
+	    }
 
-	while (index >= 0) {
-	    ExceptionRange range = envPtr->exceptArrayPtr[index];
+	    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 ((range.type == CATCH_EXCEPTION_RANGE)
-		    && (range.catchOffset == -1)) {
-		enclosingCatch = 1;
-		break;
+	    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)) {
+			/*
+			 * 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.
+			 */
+			Tcl_Obj *copy = Tcl_NewStringObj(str, length);
+			Tcl_IncrRefCount(copy);
+			exactMatch = (strpbrk(Tcl_GetString(copy),
+				"*[]?\\") == NULL);
+			Tcl_DecrRefCount(copy);
+		    }
+		    TclEmitPush(
+			    TclRegisterNewLiteral(envPtr, str, length), envPtr);
+		} else {
+		    SetLineInformation (i);
+		    code = TclCompileTokens(interp, varTokenPtr+1,
+			    varTokenPtr->numComponents, envPtr);
+		    if (code != TCL_OK) {
+			return code;
+		    }
+		}
+		varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
 	    }
-	    index--;
-	}
-	if (!enclosingCatch) {
-	    /*
-	     * ... and there is no enclosing catch. Issue the maximally
-	     * efficient exit instruction.
-	     */
 
-	    Tcl_DecrRefCount(returnOpts);
-	    TclEmitOpcode(INST_DONE, envPtr);
+	    if (exactMatch) {
+		TclEmitOpcode(INST_STR_EQ, envPtr);
+	    } else {
+		TclEmitInstInt1(INST_STR_MATCH, nocase, 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;
-    }
-
-    /*
-     * 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.
-     */
-
-    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);
-
-    TclErrorStackResetIf(interp, bytes, numBytes);
-    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
-    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
-	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
-}
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileUpvarCmd --
+ * TclCompileVariableCmd --
  *
- *	Procedure called to compile the "upvar" command.
+ *	Procedure called to reserve the local variables for the 
+ *      "variable" command. The command itself is *not* compiled.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *      Always returns TCL_OUT_LINE_COMPILE.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "upvar" command at
- *	runtime.
+ *      Indexed local variables are added to the environment.
  *
  *----------------------------------------------------------------------
  */
-
 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. */
+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. */
 {
-    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
-    int simpleVarName, isScalar, localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
-    Tcl_Obj *objPtr = Tcl_NewObj();
-
+    Tcl_Token *varTokenPtr;
+    int i, numWords;
+    CONST char *varName, *tail;
+    
     if (envPtr->procPtr == NULL) {
-	Tcl_DecrRefCount(objPtr);
-	return TCL_ERROR;
+	return TCL_OUT_LINE_COMPILE;
     }
 
     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;
-	const 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;
+    
+    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--;
 	    }
-	    CompileWord(envPtr, tokenPtr, interp, 1);
-	    otherTokenPtr = TokenAfter(tokenPtr);
-	    i = 4;
-	} else {
-	    if (!(numWords%2)) {
-		return TCL_ERROR;
+	    if ((*tail == ':') && (tail > varName)) {
+		tail++;
 	    }
-	    PushLiteral(envPtr, "1", 1);
-	    otherTokenPtr = tokenPtr;
-	    i = 3;
+	    (void) TclFindCompiledLocal(tail, (tail-varName+1),
+		    /*create*/ 1, /*flags*/ 0, envPtr->procPtr);
+	    varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
 	}
-    } 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, 0,
-		&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;
+    return TCL_OUT_LINE_COMPILE;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileVariableCmd --
+ * TclCompileWhileCmd --
  *
- *	Procedure called to compile the "variable" command.
+ *	Procedure called to compile the "while" command.
  *
  * Results:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * Side effects:
- *	Instructions are added to envPtr to execute the "variable" command at
- *	runtime.
+ *	Instructions are added to envPtr to execute the "while" 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. */
+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. */
 {
-    Tcl_Token *varTokenPtr, *valueTokenPtr;
-    int localIndex, numWords, i;
-    DefineLineInformation;	/* TIP #280 */
+    Tcl_Token *testTokenPtr, *bodyTokenPtr;
+    JumpFixup jumpEvalCondFixup;
+    int testCodeOffset, bodyCodeOffset, jumpDist;
+    int range, code;
+    char buffer[32 + TCL_INTEGER_SPACE];
+    int savedStackDepth = envPtr->currStackDepth;
+    int loopMayEnd = 1;         /* This is set to 0 if it is recognized as
+				 * an infinite loop. */
+    Tcl_Obj *boolObj;
+    int boolVal;
 
-    numWords = parsePtr->numWords;
-    if (numWords < 2) {
+    DefineLineInformation;
+
+    if (parsePtr->numWords != 3) {
+	Tcl_ResetResult(interp);
+	Tcl_AppendToObj(Tcl_GetObjResult(interp),
+	        "wrong # args: should be \"while test command\"", -1);
 	return TCL_ERROR;
     }
 
     /*
-     * Bail out if not compiling a proc body
+     * 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]
      */
 
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
+    testTokenPtr = parsePtr->tokenPtr
+	    + (parsePtr->tokenPtr->numComponents + 1);
+    bodyTokenPtr = testTokenPtr + (testTokenPtr->numComponents + 1);
+    if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
+	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
+	return TCL_OUT_LINE_COMPILE;
     }
 
     /*
-     * Loop over the (var, value) pairs.
+     * Find out if the condition is a constant. 
      */
 
-    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);
+    boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
+    Tcl_IncrRefCount(boolObj);
+    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
+    Tcl_DecrRefCount(boolObj);
+    if (code == TCL_OK) {
+	if (boolVal) {
+	    /*
+	     * it is an infinite loop 
+	     */
 
-	if (i != numWords) {
+	    loopMayEnd = 0;  
+	} else {
 	    /*
-	     * A value has been given: set the variable, pop the value
+	     * This is an empty loop: "while 0 {...}" or such.
+	     * Compile no bytecodes.
 	     */
 
-	    CompileWord(envPtr, valueTokenPtr, interp, 1);
-	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
-	    TclEmitOpcode(	INST_POP,			envPtr);
+	    goto pushResult;
 	}
     }
 
-    /*
-     * Set the result to empty
+    /* 
+     * Create a ExceptionRange record for the loop body. This is used to
+     * implement break and continue.
      */
 
-    PushLiteral(envPtr, "", 0);
-    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;
+    envPtr->exceptDepth++;
+    envPtr->maxExceptDepth =
+	TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
 
     /*
-     * 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.
+     * Jump to the evaluation of the condition. This code uses the "loop
+     * rotation" optimisation (which eliminates one branch from the loop).
+     * "while cond body" produces then:
+     *       goto A
+     *    B: body                : bodyCodeOffset
+     *    A: cond -> result      : testCodeOffset, continueOffset
+     *       if (result) goto B
      *
-     * 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.
+     * The infinite loop "while 1 body" produces:
+     *    B: body                : all three offsets here
+     *       goto B
      */
 
-    if (!EnvHasLVT(envPtr)) {
-	return -1;
-    }
-
-    TclNewObj(tailPtr);
-    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
-	full = 1;
-	lastTokenPtr = varTokenPtr;
+    if (loopMayEnd) {
+	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
+	testCodeOffset = 0; /* avoid compiler warning */
     } else {
-	full = 0;
-	lastTokenPtr = varTokenPtr + n;
-	if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
-	    Tcl_DecrRefCount(tailPtr);
-	    return -1;
-	}
+	testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
     }
+    
 
-    tailName = TclGetStringFromObj(tailPtr, &len);
-
-    if (len) {
-	if (*(tailName+len-1) == ')') {
-	    /*
-	     * Possible array: bail out
-	     */
+    /*
+     * Compile the loop body.
+     */
 
-	    Tcl_DecrRefCount(tailPtr);
-	    return -1;
-	}
+    SetLineInformation (2);
+    bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+    code = TclCompileCmdWord(interp, bodyTokenPtr+1,
+	    bodyTokenPtr->numComponents, envPtr);
+    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);
 
-	/*
-	 * Get the tail: immediately after the last '::'
-	 */
+    /*
+     * Compile the test expression then emit the conditional jump that
+     * terminates the while. We already know it's a simple word.
+     */
 
-	for (p = tailName + len -1; p > tailName; p--) {
-	    if ((*p == ':') && (*(p-1) == ':')) {
-		p++;
-		break;
+    if (loopMayEnd) {
+	testCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
+	if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
+	    bodyCodeOffset += 3;
+	    testCodeOffset += 3;
+	}
+	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;
 	}
-	if (!full && (p == tailName)) {
-	    /*
-	     * No :: in the last component.
-	     */
-
-	    Tcl_DecrRefCount(tailPtr);
-	    return -1;
+	envPtr->currStackDepth = savedStackDepth + 1;
+    
+	jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+	if (jumpDist > 127) {
+	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
+	} else {
+	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
 	}
-	len -= p - tailName;
-	tailName = p;
+    } else {
+	jumpDist = (envPtr->codeNext - envPtr->codeStart) - bodyCodeOffset;
+	if (jumpDist > 127) {
+	    TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
+	} else {
+	    TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
+	}	
     }
 
-    localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr);
-    Tcl_DecrRefCount(tailPtr);
-    return localIndex;
+
+    /*
+     * 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);
+    
+    /*
+     * The while command's result is an empty string.
+     */
+
+    pushResult:
+    envPtr->currStackDepth = savedStackDepth;
+    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+    envPtr->exceptDepth--;
+    return TCL_OK;
+
+    error:
+    envPtr->exceptDepth--;
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * PushVarName --
+ * TclPushVarName --
  *
- *	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:
- *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
- *	evaluation to runtime.
+ *	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.
  *
  * 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
-PushVarName(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Token *varTokenPtr,	/* Points to a variable token. */
-    CompileEnv *envPtr,		/* Holds resulting instructions. */
-    int flags,			/* 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. */
+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;
+    register CONST char *p;
+    CONST char *name, *elName;
     register int i, n;
-    Tcl_Token *elemTokenPtr = NULL;
     int nameChars, elNameChars, simpleVarName, localIndex;
-    int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;
+    int code = TCL_OK;
+
+    Tcl_Token *elemTokenPtr = NULL;
+    int elemTokenCount = 0;
+    int allocedTokens = 0;
+    int 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;
@@ -4480,8 +3267,8 @@ PushVarName(
 
     /*
      * 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.
      */
@@ -4492,32 +3279,31 @@ PushVarName(
 	 * 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 = TclStackAlloc(interp, sizeof(Tcl_Token));
+		elemTokenPtr = (Tcl_Token *) ckalloc(sizeof(Tcl_Token));
 		allocedTokens = 1;
 		elemTokenPtr->type = TCL_TOKEN_TEXT;
 		elemTokenPtr->start = elName;
@@ -4528,69 +3314,70 @@ PushVarName(
 	}
     } 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] == ')')) {
-	/*
-	 * Check for parentheses inside first token.
+            && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
+            && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
+
+        /*
+	 * 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) {
-		n--;
+		--n;
 	    } else {
-		varTokenPtr[n].size--;
+		--varTokenPtr[n].size;
 		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 = TclStackAlloc(interp, n * sizeof(Tcl_Token));
+		elemTokenPtr = (Tcl_Token *) ckalloc(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(elemTokenPtr+1, varTokenPtr+2,
-			(n-1) * sizeof(Tcl_Token));
+		
+		memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]),
+		       ((n-1) * sizeof(Tcl_Token)));
 	    } else {
 		/*
 		 * Use the already available tokens.
 		 */
-
+		
 		elemTokenPtr = &varTokenPtr[2];
-		elemTokenCount = n - 1;
+		elemTokenCount = n - 1;	    
 	    }
 	}
     }
@@ -4601,7 +3388,6 @@ PushVarName(
 	 */
 
 	int hasNsQualifiers = 0;
-
 	for (i = 0, p = name;  i < nameChars;  i++, p++) {
 	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
 		hasNsQualifiers = 1;
@@ -4610,24 +3396,23 @@ PushVarName(
 	}
 
 	/*
-	 * 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 (!hasNsQualifiers) {
+	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
 	    localIndex = TclFindCompiledLocal(name, nameChars,
-		    1, envPtr);
+		    /*create*/ (flags & TCL_CREATE_VAR),
+                    /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY),
+		    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) {
-	    PushLiteral(envPtr, name, nameChars);
+	    TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr);
 	}
 
 	/*
@@ -4636,12 +3421,17 @@ PushVarName(
 
 	if (elName != NULL) {
 	    if (elNameChars) {
-		envPtr->line = line;
-		envPtr->clNext = clNext;
-		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
-			envPtr);
+#ifdef TCL_TIP280
+	        envPtr->line   = line;
+	        envPtr->clNext = clNext;
+#endif
+		code = TclCompileTokens(interp, elemTokenPtr,
+                        elemTokenCount, envPtr);
+		if (code != TCL_OK) {
+		    goto done;
+		}
 	    } else {
-		PushLiteral(envPtr, "", 0);
+		TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
 	    }
 	}
     } else {
@@ -4649,21 +3439,28 @@ PushVarName(
 	 * The var name isn't simple: compile and push it.
 	 */
 
-	envPtr->line = line;
-	envPtr->clNext = clNext;
-	CompileTokens(envPtr, varTokenPtr, interp);
+#ifdef TCL_TIP280
+        envPtr->line   = line;
+        envPtr->clNext = clNext;
+#endif
+	code = TclCompileTokens(interp, varTokenPtr+1,
+		varTokenPtr->numComponents, envPtr);
+	if (code != TCL_OK) {
+	    goto done;
+	}
     }
 
+    done:
     if (removedParen) {
-	varTokenPtr[removedParen].size++;
+	++varTokenPtr[removedParen].size;
     }
     if (allocedTokens) {
-	TclStackFree(interp, elemTokenPtr);
+        ckfree((char *) elemTokenPtr);
     }
-    *localIndexPtr = localIndex;
-    *simpleVarNamePtr = simpleVarName;
-    *isScalarPtr = (elName == NULL);
-    return TCL_OK;
+    *localIndexPtr	= localIndex;
+    *simpleVarNamePtr	= simpleVarName;
+    *isScalarPtr	= (elName == NULL);
+    return code;
 }
 
 /*
@@ -4673,3 +3470,4 @@ PushVarName(
  * fill-column: 78
  * End:
  */
+
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
deleted file mode 100644
index b950e21..0000000
--- a/generic/tclCompCmdsSZ.c
+++ /dev/null
@@ -1,3585 +0,0 @@
-/*
- * tclCompCmdsSZ.c --
- *
- *	This file contains compilation procedures that compile various Tcl
- *	commands (beginning with the letters 's' through 'z', except for
- *	[upvar] and [variable]) into a sequence of instructions ("bytecodes").
- *	Also includes the operator command compilers.
- *
- * 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-2010 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 "tclCompile.h"
-
-/*
- * Prototypes for procedures defined later in this file:
- */
-
-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		IssueSwitchChainedTests(Tcl_Interp *interp,
-			    CompileEnv *envPtr, ExtCmdLoc *mapPtr,
-			    int eclIndex, int mode, int noCase,
-			    int valueIndex, Tcl_Token *valueTokenPtr,
-			    int numWords, Tcl_Token **bodyToken,
-			    int *bodyLines, int **bodyNext);
-static void		IssueSwitchJumpTable(Tcl_Interp *interp,
-			    CompileEnv *envPtr, ExtCmdLoc *mapPtr,
-			    int eclIndex, int valueIndex,
-			    Tcl_Token *valueTokenPtr, int numWords,
-			    Tcl_Token **bodyToken, int *bodyLines,
-			    int **bodyContLines);
-static int		IssueTryFinallyInstructions(Tcl_Interp *interp,
-			    CompileEnv *envPtr, Tcl_Token *bodyToken,
-			    int numHandlers, int *matchCodes,
-			    Tcl_Obj **matchClauses, int *resultVarIndices,
-			    int *optionVarIndices, Tcl_Token **handlerTokens,
-			    Tcl_Token *finallyToken);
-static int		IssueTryInstructions(Tcl_Interp *interp,
-			    CompileEnv *envPtr, Tcl_Token *bodyToken,
-			    int numHandlers, int *matchCodes,
-			    Tcl_Obj **matchClauses, int *resultVarIndices,
-			    int *optionVarIndices, Tcl_Token **handlerTokens);
-
-/*
- * 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);
- */
-
-#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.
- *
- * Macro to encapsulate the variable definition and setup.
- */
-
-#define DefineLineInformation \
-    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
-    int eclIndex = mapPtr->nuloc - 1
-
-#define SetLineInformation(word) \
-    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
-    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]
-
-#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_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
-
-/*
- * The structures below define the AuxData types defined in this file.
- */
-
-const AuxDataType tclJumptableInfoType = {
-    "JumptableInfo",		/* name */
-    DupJumptableInfo,		/* dupProc */
-    FreeJumptableInfo,		/* freeProc */
-    PrintJumptableInfo		/* printProc */
-};
-
-/*
- * Shorthand macros for instruction issuing.
- */
-
-#define OP(name)	TclEmitOpcode(INST_##name, envPtr)
-#define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
-#define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
-#define OP44(name,val1,val2) \
-    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
-#define BODY(token,index) \
-    SetLineInformation((index));CompileBody(envPtr,(token),interp)
-#define PUSH(str) \
-    PushLiteral(envPtr,(str),strlen(str))
-#define JUMP(var,name) \
-    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr)
-#define FIXJUMP(var) \
-    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
-#define LOAD(idx) \
-    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
-#define STORE(idx) \
-    if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileSetCmd --
- *
- *	Procedure called to compile the "set" 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 "set" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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;
-    DefineLineInformation;	/* TIP #280 */
-
-    numWords = parsePtr->numWords;
-    if ((numWords != 2) && (numWords != 3)) {
-	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.
-     */
-
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-	    &localIndex, &simpleVarName, &isScalar, 1);
-
-    /*
-     * If we are doing an assignment, push the new value.
-     */
-
-    if (isAssignment) {
-	valueTokenPtr = TokenAfter(varTokenPtr);
-	CompileWord(envPtr, valueTokenPtr, interp, 2);
-    }
-
-    /*
-     * Emit instructions to set/get the variable.
-     */
-
-    if (simpleVarName) {
-	if (isScalar) {
-	    if (localIndex < 0) {
-		TclEmitOpcode((isAssignment?
-			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) {
-		TclEmitOpcode((isAssignment?
-			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);
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileStringCmpCmd --
- *
- *	Procedure called to compile the simplest and most common form of the
- *	"string compare" 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 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
-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;
-
-    /*
-     * 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_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;
-    Tcl_Obj *objPtr;
-
-    if (parsePtr->numWords != 2) {
-	return TCL_ERROR;
-    }
-
-    tokenPtr = TokenAfter(parsePtr->tokenPtr);
-    TclNewObj(objPtr);
-    if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
-	/*
-	 * Here someone is asking for the length of a static string (or
-	 * something with backslashes). Just push the actual character (not
-	 * byte) length.
-	 */
-
-	char buf[TCL_INTEGER_SPACE];
-	int len = Tcl_GetCharLength(objPtr);
-
-	len = sprintf(buf, "%d", len);
-	PushLiteral(envPtr, buf, len);
-    } else {
-	SetLineInformation(1);
-	CompileTokens(envPtr, tokenPtr, interp);
-	TclEmitOpcode(INST_STR_LEN, envPtr);
-    }
-    TclDecrRefCount(objPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileSubstCmd --
- *
- *	Procedure called to compile the "subst" 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 "subst" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileSubstCmd(
-    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. */
-{
-    int numArgs = parsePtr->numWords - 1;
-    int numOpts = numArgs - 1;
-    int objc, flags = TCL_SUBST_ALL;
-    Tcl_Obj **objv/*, *toSubst = NULL*/;
-    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    int code = TCL_ERROR;
-    DefineLineInformation;	/* TIP #280 */
-
-    if (numArgs == 0) {
-	return TCL_ERROR;
-    }
-
-    objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));
-
-    for (objc = 0; objc < /*numArgs*/ numOpts; objc++) {
-	objv[objc] = Tcl_NewObj();
-	Tcl_IncrRefCount(objv[objc]);
-	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
-	    objc++;
-	    goto cleanup;
-	}
-	wordTokenPtr = TokenAfter(wordTokenPtr);
-    }
-
-/*
-    if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) {
-	toSubst = objv[numOpts];
-	Tcl_IncrRefCount(toSubst);
-    }
-*/
-
-    /* TODO: Figure out expansion to cover WordKnownAtCompileTime
-     *	The difficulty is that WKACT makes a copy, and if TclSubstParse
-     *	below parses the copy of the original source string, some deep
-     *	parts of the compile machinery get upset.  They want all pointers
-     *	stored in Tcl_Tokens to point back to the same original string.
-     */
-    if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	code = TclSubstOptions(NULL, numOpts, objv, &flags);
-    }
-
-  cleanup:
-    while (--objc >= 0) {
-	TclDecrRefCount(objv[objc]);
-    }
-    TclStackFree(interp, objv);
-    if (/*toSubst == NULL*/ code != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    SetLineInformation(numArgs);
-    TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
-	    flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);
-
-/*    TclDecrRefCount(toSubst);*/
-    return TCL_OK;
-}
-
-void
-TclSubstCompile(
-    Tcl_Interp *interp,
-    const char *bytes,
-    int numBytes,
-    int flags,
-    int line,
-    CompileEnv *envPtr)
-{
-    Tcl_Token *endTokenPtr, *tokenPtr;
-    int breakOffset = 0, count = 0, bline = line;
-    Tcl_Parse parse;
-    Tcl_InterpState state = NULL;
-
-    TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
-
-    /*
-     * Tricky point! If the first token does not result in a *guaranteed* push
-     * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it
-     * is possible to get to an INST_CONCAT1 or INST_DONE without enough
-     * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
-     * identifying a script that could trigger this case.
-     */
-
-    tokenPtr = parse.tokenPtr;
-    if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
-	PushLiteral(envPtr, "", 0);
-	count++;
-    }
-
-    for (endTokenPtr = tokenPtr + parse.numTokens;
-	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
-	int length, literal, catchRange, breakJump;
-	char buf[TCL_UTF_MAX];
-	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
-	JumpFixup continueFixup, otherFixup, endFixup;
-
-	switch (tokenPtr->type) {
-	case TCL_TOKEN_TEXT:
-	    literal = TclRegisterNewLiteral(envPtr,
-		    tokenPtr->start, tokenPtr->size);
-	    TclEmitPush(literal, envPtr);
-	    TclAdvanceLines(&bline, tokenPtr->start,
-		    tokenPtr->start + tokenPtr->size);
-	    count++;
-	    continue;
-	case TCL_TOKEN_BS:
-	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
-		    NULL, buf);
-	    literal = TclRegisterNewLiteral(envPtr, buf, length);
-	    TclEmitPush(literal, envPtr);
-	    count++;
-	    continue;
-	}
-
-	while (count > 255) {
-	    TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
-	    count -= 254;
-	}
-	if (count > 1) {
-	    TclEmitInstInt1(INST_CONCAT1, count, envPtr);
-	    count = 1;
-	}
-
-	if (breakOffset == 0) {
-	    /* Jump to the start (jump over the jump to end) */
-	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup);
-
-	    /* Jump to the end (all BREAKs land here) */
-	    breakOffset = CurrentOffset(envPtr);
-	    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
-
-	    /* Start */
-	    if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
-		Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d",
-			(int) (CurrentOffset(envPtr) - startFixup.codeOffset));
-	    }
-	}
-
-	envPtr->line = bline;
-	catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
-	TclEmitInstInt4(INST_BEGIN_CATCH4, catchRange, envPtr);
-	ExceptionRangeStarts(envPtr, catchRange);
-
-	switch (tokenPtr->type) {
-	case TCL_TOKEN_COMMAND:
-	    TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2,
-		    envPtr);
-	    count++;
-	    break;
-	case TCL_TOKEN_VARIABLE:
-	    TclCompileVarSubst(interp, tokenPtr, envPtr);
-	    count++;
-	    break;
-	default:
-	    Tcl_Panic("unexpected token type in TclCompileSubstCmd: %d",
-		    tokenPtr->type);
-	}
-
-	ExceptionRangeEnds(envPtr, catchRange);
-
-	/* Substitution produced TCL_OK */
-	TclEmitOpcode(INST_END_CATCH, envPtr);
-	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
-
-	/* Exceptional return codes processed here */
-	ExceptionRangeTarget(envPtr, catchRange, catchOffset);
-	TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
-	TclEmitOpcode(INST_PUSH_RESULT, envPtr);
-	TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);
-	TclEmitOpcode(INST_END_CATCH, envPtr);
-	TclEmitOpcode(INST_RETURN_CODE_BRANCH, envPtr);
-
-	/* ERROR -> reraise it */
-	TclEmitOpcode(INST_RETURN_STK, envPtr);
-	TclEmitOpcode(INST_NOP, envPtr);
-
-	/* RETURN */
-	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);
-
-	/* BREAK */
-	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &breakFixup);
-
-	/* CONTINUE */
-	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &continueFixup);
-
-	/* OTHER */
-	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup);
-
-	/* BREAK destination */
-	if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
-	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
-		    (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
-	}
-	TclEmitOpcode(INST_POP, envPtr);
-	TclEmitOpcode(INST_POP, envPtr);
-
-	breakJump = CurrentOffset(envPtr) - breakOffset;
-	if (breakJump > 127) {
-	    TclEmitInstInt4(INST_JUMP4, -breakJump, envPtr);
-	} else {
-	    TclEmitInstInt1(INST_JUMP1, -breakJump, envPtr);
-	}
-
-	/* CONTINUE destination */
-	if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
-	    Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
-		    (int) (CurrentOffset(envPtr) - continueFixup.codeOffset));
-	}
-	TclEmitOpcode(INST_POP, envPtr);
-	TclEmitOpcode(INST_POP, envPtr);
-	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);
-
-	/* RETURN + other destination */
-	if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
-	    Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d",
-		    (int) (CurrentOffset(envPtr) - returnFixup.codeOffset));
-	}
-	if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
-	    Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d",
-		    (int) (CurrentOffset(envPtr) - otherFixup.codeOffset));
-	}
-
-	/*
-	 * Pull the result to top of stack, discard options dict.
-	 */
-
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
-	TclEmitOpcode(INST_POP, envPtr);
-
-	/*
-	 * We've emitted several POP instructions, and the automatic
-	 * computations for stack depth requirements have been decrementing
-	 * for every one.  However, we know that every branch actually taken
-	 * only encounters some of those instructions.  No branch passes
-	 * through them all.  So, we now have a stack requirements estimate
-	 * that is too low.  Here we manually fix that up.
-	 */
-
-	TclAdjustStackDepth(5, envPtr);
-
-	/* OK destination */
-	if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
-	    Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
-		    (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
-	}
-	if (count > 1) {
-	    TclEmitInstInt1(INST_CONCAT1, count, envPtr);
-	    count = 1;
-	}
-
-	/* CONTINUE jump to here */
-	if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
-	    Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d",
-		    (int) (CurrentOffset(envPtr) - endFixup.codeOffset));
-	}
-	bline = envPtr->line;
-    }
-
-
-    while (count > 255) {
-	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
-	count -= 254;
-    }
-    if (count > 1) {
-	TclEmitInstInt1(INST_CONCAT1, count, envPtr);
-    }
-
-    Tcl_FreeParse(&parse);
-
-    if (state != NULL) {
-	Tcl_RestoreInterpState(interp, state);
-	TclCompileSyntaxError(interp, envPtr);
-    }
-
-    /* Final target of the multi-jump from all BREAKs */
-    if (breakOffset > 0) {
-	TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset,
-		envPtr->codeStart + breakOffset);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 **bodyContLines;	/* Array of continuation line info. */
-    int noCase;			/* Has the -nocase flag been given? */
-    int foundMode = 0;		/* Have we seen a mode flag yet? */
-    int i, valueIndex;
-    int result = TCL_ERROR;
-    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 = ckalloc(sizeof(Tcl_Token) * maxLen);
-	bodyToken = ckalloc(sizeof(Tcl_Token *) * maxLen);
-	bodyLines = ckalloc(sizeof(int) * maxLen);
-	bodyContLines = 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) {
-	    abort:
-		ckfree((char *) bodyToken);
-		ckfree((char *) bodyTokenArray);
-		ckfree((char *) bodyLines);
-		ckfree((char *) bodyContLines);
-		return TCL_ERROR;
-	    }
-
-	    bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
-	    bodyTokenArray[numWords].numComponents = 0;
-	    bodyToken[numWords] = bodyTokenArray + numWords;
-
-	    /*
-	     * 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).
-	     */
-
-	    TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start);
-	    TclAdvanceContinuations(&bline, &clNext,
-		    bodyTokenArray[numWords].start - envPtr->source);
-	    bodyLines[numWords] = bline;
-	    bodyContLines[numWords] = clNext;
-	    TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
-	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);
-
-	    numBytes -= (bytes - prevBytes);
-	    numWords++;
-	}
-	if (numWords % 2) {
-	    goto abort;
-	}
-    } 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 = ckalloc(sizeof(Tcl_Token *) * numWords);
-	bodyLines = ckalloc(sizeof(int) * numWords);
-	bodyContLines = ckalloc(sizeof(int*) * numWords);
-	bodyTokenArray = NULL;
-	for (i=0 ; i<numWords ; i++) {
-	    /*
-	     * 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 (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		goto freeTemporaries;
-	    }
-	    bodyToken[i] = tokenPtr+1;
-
-	    /*
-	     * TIP #280: Copy line information from regular cmd info.
-	     */
-
-	    bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
-	    bodyContLines[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
-	    tokenPtr = TokenAfter(tokenPtr);
-	}
-    }
-
-    /*
-     * 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] == '-') {
-	goto freeTemporaries;
-    }
-
-    /*
-     * Now we commit to generating code; the parsing stage per se is done.
-     * 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) {
-	IssueSwitchJumpTable(interp, envPtr, mapPtr, eclIndex, valueIndex,
-		valueTokenPtr, numWords, bodyToken, bodyLines, bodyContLines);
-    } else {
-	IssueSwitchChainedTests(interp, envPtr, mapPtr, eclIndex, mode,noCase,
-		valueIndex, valueTokenPtr, numWords, bodyToken, bodyLines,
-		bodyContLines);
-    }
-    result = TCL_OK;
-
-    /*
-     * Clean up all our temporary space and return.
-     */
-
-  freeTemporaries:
-    ckfree(bodyToken);
-    ckfree(bodyLines);
-    ckfree(bodyContLines);
-    if (bodyTokenArray != NULL) {
-	ckfree(bodyTokenArray);
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * IssueSwitchChainedTests --
- *
- *	Generate instructions for a [switch] command that is to be compiled
- *	into a sequence of tests. This is the generic handle-everything mode
- *	that inherently has performance that is (on average) linear in the
- *	number of tests. It is the only mode that can handle -glob and -regexp
- *	matches, or anything that is case-insensitive. It does not handle the
- *	wild-and-wooly end of regexp matching (i.e., capture of match results)
- *	so that's when we spill to the interpreted version.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-IssueSwitchChainedTests(
-    Tcl_Interp *interp,		/* Context for compiling script bodies. */
-    CompileEnv *envPtr,		/* Holds resulting instructions. */
-    ExtCmdLoc *mapPtr,		/* For mapping tokens to their source code
-				 * location. */
-    int eclIndex,
-    int mode,			/* Exact, Glob or Regexp */
-    int noCase,			/* Case-insensitivity flag. */
-    int valueIndex,		/* The value to match against. */
-    Tcl_Token *valueTokenPtr,
-    int numBodyTokens,		/* Number of tokens describing things the
-				 * switch can match against and bodies to
-				 * execute when the match succeeds. */
-    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
-    int *bodyLines,		/* Array of line numbers for body list
-				 * items. */
-    int **bodyContLines)	/* Array of continuation line info. */
-{
-    enum {Switch_Exact, Switch_Glob, Switch_Regexp};
-    int savedStackDepth = envPtr->currStackDepth;
-    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 nextArmFixupIndex;
-    int simple, exact;		/* For extracting the type of regexp. */
-    int i;
-
-    /*
-     * First, we push the value we're matching against on the stack.
-     */
-
-    SetLineInformation(valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
-
-    /*
-     * Generate a test for each arm.
-     */
-
-    contFixIndex = -1;
-    contFixCount = 0;
-    fixupArray = TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
-    fixupTargetArray = TclStackAlloc(interp, sizeof(int) * numBodyTokens);
-    memset(fixupTargetArray, 0, numBodyTokens * sizeof(int));
-    fixupCount = 0;
-    foundDefault = 0;
-    for (i=0 ; i<numBodyTokens ; i+=2) {
-	nextArmFixupIndex = -1;
-	envPtr->currStackDepth = savedStackDepth + 1;
-	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
-		memcmp(bodyToken[numBodyTokens-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:
-		simple = exact = 0;
-
-		/*
-		 * Keep in sync with TclCompileRegexpCmd.
-		 */
-
-		if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
-		    Tcl_DString ds;
-
-		    if (bodyToken[i]->size == 0) {
-			/*
-			 * The semantics of regexps are that they always match
-			 * when the RE == "".
-			 */
-
-			PushLiteral(envPtr, "1", 1);
-			break;
-		    }
-
-		    /*
-		     * 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) {
-		    /*
-		     * 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);
-		} else if (exact && !noCase) {
-		    TclEmitOpcode(INST_STR_EQ,			envPtr);
-		} else {
-		    TclEmitInstInt1(INST_STR_MATCH, noCase,	envPtr);
-		}
-		break;
-	    default:
-		Tcl_Panic("unknown switch mode: %d", mode);
-	    }
-
-	    /*
-	     * 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;
-	    }
-
-	    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 = bodyContLines[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);
-	}
-    }
-
-    /*
-     * 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;
-		}
-	    }
-	}
-    }
-    TclStackFree(interp, fixupTargetArray);
-    TclStackFree(interp, fixupArray);
-
-    envPtr->currStackDepth = savedStackDepth + 1;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * IssueSwitchJumpTable --
- *
- *	Generate instructions for a [switch] command that is to be compiled
- *	into a jump table. This only handles the case where case-sensitive,
- *	exact matching is used, but this is actually the most common case in
- *	real code.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-IssueSwitchJumpTable(
-    Tcl_Interp *interp,		/* Context for compiling script bodies. */
-    CompileEnv *envPtr,		/* Holds resulting instructions. */
-    ExtCmdLoc *mapPtr,		/* For mapping tokens to their source code
-				 * location. */
-    int eclIndex,
-    int valueIndex,		/* The value to match against. */
-    Tcl_Token *valueTokenPtr,
-    int numBodyTokens,		/* Number of tokens describing things the
-				 * switch can match against and bodies to
-				 * execute when the match succeeds. */
-    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
-    int *bodyLines,		/* Array of line numbers for body list
-				 * items. */
-    int **bodyContLines)	/* Array of continuation line info. */
-{
-    JumptableInfo *jtPtr;
-    int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
-    int mustGenerate, foundDefault, jumpToDefault, i;
-    Tcl_DString buffer;
-    Tcl_HashEntry *hPtr;
-
-    /*
-     * First, we push the value we're matching against on the stack.
-     */
-
-    SetLineInformation(valueIndex);
-    CompileTokens(envPtr, valueTokenPtr, interp);
-
-    /*
-     * 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 = ckalloc(sizeof(JumptableInfo));
-    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
-    infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
-    finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/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<numBodyTokens ; i+=2) {
-	/*
-	 * For each arm, we must first work out what to do with the match
-	 * term.
-	 */
-
-	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
-		memcmp(bodyToken[numBodyTokens-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, CurrentOffset(envPtr) - jumpLocation);
-	    }
-	    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);
-	}
-
-	/*
-	 * 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 = bodyContLines[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 < numBodyTokens || !foundDefault) {
-	    finalFixups[numRealBodies++] = CurrentOffset(envPtr);
-
-	    /*
-	     * Easier by far to issue this jump as a fixed-width jump, since
-	     * otherwise we'd need to do a lot more (and more awkward)
-	     * rewriting when we fixed this all up.
-	     */
-
-	    TclEmitInstInt4(INST_JUMP4, 0,			envPtr);
-	}
-    }
-
-    /*
-     * 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 (!foundDefault) {
-	TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
-		envPtr->codeStart+jumpToDefault+1);
-	PushLiteral(envPtr, "", 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.
-     */
-
-    TclStackFree(interp, finalFixups);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DupJumptableInfo, FreeJumptableInfo --
- *
- *	Functions to duplicate, release and print a jump-table created for use
- *	with the INST_JUMP_TABLE instruction.
- *
- * Results:
- *	DupJumptableInfo: a copy of the jump-table
- *	FreeJumptableInfo: none
- *	PrintJumptableInfo: none
- *
- * Side effects:
- *	DupJumptableInfo: allocates memory
- *	FreeJumptableInfo: releases memory
- *	PrintJumptableInfo: none
- *
- *----------------------------------------------------------------------
- */
-
-static ClientData
-DupJumptableInfo(
-    ClientData clientData)
-{
-    JumptableInfo *jtPtr = clientData;
-    JumptableInfo *newJtPtr = 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;
-}
-
-static void
-FreeJumptableInfo(
-    ClientData clientData)
-{
-    JumptableInfo *jtPtr = clientData;
-
-    Tcl_DeleteHashTable(&jtPtr->hashTable);
-    ckfree(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);
-	    }
-	}
-	Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
-		keyPtr, pcOffset + offset);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileThrowCmd --
- *
- *	Procedure called to compile the "throw" 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 "throw" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileThrowCmd(
-    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 */
-    int numWords = parsePtr->numWords;
-    Tcl_Token *codeToken, *msgToken;
-    Tcl_Obj *objPtr;
-
-    if (numWords != 3) {
-	return TCL_ERROR;
-    }
-    codeToken = TokenAfter(parsePtr->tokenPtr);
-    msgToken = TokenAfter(codeToken);
-
-    TclNewObj(objPtr);
-    Tcl_IncrRefCount(objPtr);
-    if (TclWordKnownAtCompileTime(codeToken, objPtr)) {
-	Tcl_Obj *errPtr, *dictPtr;
-	const char *string;
-	int len;
-
-	/*
-	 * The code is known at compilation time. This allows us to issue a
-	 * very efficient sequence of instructions.
-	 */
-
-	if (Tcl_ListObjLength(interp, objPtr, &len) != TCL_OK) {
-	    /*
-	     * Must still do this; might generate an error when getting this
-	     * "ignored" value prepared as an argument.
-	     */
-
-	    CompileWord(envPtr, msgToken, interp, 2);
-	    TclCompileSyntaxError(interp, envPtr);
-	    Tcl_DecrRefCount(objPtr);
-	    return TCL_OK;
-	}
-	if (len == 0) {
-	    /*
-	     * Must still do this; might generate an error when getting this
-	     * "ignored" value prepared as an argument.
-	     */
-
-	    CompileWord(envPtr, msgToken, interp, 2);
-	    goto issueErrorForEmptyCode;
-	}
-	TclNewLiteralStringObj(errPtr, "-errorcode");
-	TclNewObj(dictPtr);
-	Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr);
-	Tcl_IncrRefCount(dictPtr);
-	string = Tcl_GetStringFromObj(dictPtr, &len);
-	CompileWord(envPtr, msgToken, interp, 2);
-	PushLiteral(envPtr, string, len);
-	TclDecrRefCount(dictPtr);
-	OP44(				RETURN_IMM, 1, 0);
-    } else {
-	/*
-	 * When the code token is not known at compilation time, we need to do
-	 * a little bit more work. The main tricky bit here is that the error
-	 * code has to be a list (a [throw] restriction) so we must emit extra
-	 * instructions to enforce that condition.
-	 */
-
-	CompileWord(envPtr, codeToken, interp, 1);
-	PUSH(				"-errorcode");
-	CompileWord(envPtr, msgToken, interp, 2);
-	OP4(				REVERSE, 3);
-	OP(				DUP);
-	OP(				LIST_LENGTH);
-	OP1(				JUMP_FALSE1, 16);
-	OP4(				LIST, 2);
-	OP44(				RETURN_IMM, 1, 0);
-
-	/*
-	 * Generate an error for being an empty list. Can't leverage anything
-	 * else to do this for us.
-	 */
-
-    issueErrorForEmptyCode:
-	PUSH(				"type must be non-empty list");
-	PUSH(				"");
-	OP44(				RETURN_IMM, 1, 0);
-    }
-    TclDecrRefCount(objPtr);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileTryCmd --
- *
- *	Procedure called to compile the "try" 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 "try" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileTryCmd(
-    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. */
-{
-    int numWords = parsePtr->numWords, numHandlers, result = TCL_ERROR;
-    Tcl_Token *bodyToken, *finallyToken, *tokenPtr;
-    Tcl_Token **handlerTokens = NULL;
-    Tcl_Obj **matchClauses = NULL;
-    int *matchCodes=NULL, *resultVarIndices=NULL, *optionVarIndices=NULL;
-    int i;
-
-    if (numWords < 2) {
-	return TCL_ERROR;
-    }
-
-    bodyToken = TokenAfter(parsePtr->tokenPtr);
-
-    if (numWords == 2) {
-	/*
-	 * No handlers or finally; do nothing beyond evaluating the body.
-	 */
-
-	DefineLineInformation;	/* TIP #280 */
-	SetLineInformation(1);
-	CompileBody(envPtr, bodyToken, interp);
-	return TCL_OK;
-    }
-
-    numWords -= 2;
-    tokenPtr = TokenAfter(bodyToken);
-
-    /*
-     * Extract information about what handlers there are.
-     */
-
-    numHandlers = numWords >> 2;
-    numWords -= numHandlers * 4;
-    if (numHandlers > 0) {
-	handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
-	matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
-	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
-	matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers);
-	resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
-	optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
-
-	for (i=0 ; i<numHandlers ; i++) {
-	    Tcl_Obj *tmpObj, **objv;
-	    int objc;
-
-	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		goto failedToCompile;
-	    }
-	    if (tokenPtr[1].size == 4
-		    && !strncmp(tokenPtr[1].start, "trap", 4)) {
-		/*
-		 * Parse the list of errorCode words to match against.
-		 */
-
-		matchCodes[i] = TCL_ERROR;
-		tokenPtr = TokenAfter(tokenPtr);
-		TclNewObj(tmpObj);
-		Tcl_IncrRefCount(tmpObj);
-		if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)
-			|| Tcl_ListObjLength(NULL, tmpObj, &objc) != TCL_OK
-			|| (objc == 0)) {
-		    TclDecrRefCount(tmpObj);
-		    goto failedToCompile;
-		}
-		Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL);
-		matchClauses[i] = tmpObj;
-	    } else if (tokenPtr[1].size == 2
-		    && !strncmp(tokenPtr[1].start, "on", 2)) {
-		int code;
-
-		/*
-		 * Parse the result code to look for.
-		 */
-
-		tokenPtr = TokenAfter(tokenPtr);
-		TclNewObj(tmpObj);
-		Tcl_IncrRefCount(tmpObj);
-		if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
-		    TclDecrRefCount(tmpObj);
-		    goto failedToCompile;
-		}
-		if (TCL_ERROR == TclGetCompletionCodeFromObj(NULL, tmpObj, &code)) {
-		    TclDecrRefCount(tmpObj);
-		    goto failedToCompile;
-		}
-		matchCodes[i] = code;
-		TclDecrRefCount(tmpObj);
-	    } else {
-		goto failedToCompile;
-	    }
-
-	    /*
-	     * Parse the variable binding.
-	     */
-
-	    tokenPtr = TokenAfter(tokenPtr);
-	    TclNewObj(tmpObj);
-	    Tcl_IncrRefCount(tmpObj);
-	    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
-		TclDecrRefCount(tmpObj);
-		goto failedToCompile;
-	    }
-	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
-		    || (objc > 2)) {
-		TclDecrRefCount(tmpObj);
-		goto failedToCompile;
-	    }
-	    if (objc > 0) {
-		int len;
-		const char *varname = Tcl_GetStringFromObj(objv[0], &len);
-
-		if (!TclIsLocalScalar(varname, len)) {
-		    TclDecrRefCount(tmpObj);
-		    goto failedToCompile;
-		}
-		resultVarIndices[i] =
-			TclFindCompiledLocal(varname, len, 1, envPtr);
-	    } else {
-		resultVarIndices[i] = -1;
-	    }
-	    if (objc == 2) {
-		int len;
-		const char *varname = Tcl_GetStringFromObj(objv[1], &len);
-
-		if (!TclIsLocalScalar(varname, len)) {
-		    TclDecrRefCount(tmpObj);
-		    goto failedToCompile;
-		}
-		optionVarIndices[i] =
-			TclFindCompiledLocal(varname, len, 1, envPtr);
-	    } else {
-		optionVarIndices[i] = -1;
-	    }
-	    TclDecrRefCount(tmpObj);
-
-	    /*
-	     * Extract the body for this handler.
-	     */
-
-	    tokenPtr = TokenAfter(tokenPtr);
-	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		goto failedToCompile;
-	    }
-	    if (tokenPtr[1].size == 1 && tokenPtr[1].start[0] == '-') {
-		handlerTokens[i] = NULL;
-	    } else {
-		handlerTokens[i] = tokenPtr;
-	    }
-
-	    tokenPtr = TokenAfter(tokenPtr);
-	}
-
-	if (handlerTokens[numHandlers-1] == NULL) {
-	    goto failedToCompile;
-	}
-    }
-
-    /*
-     * Parse the finally clause
-     */
-
-    if (numWords == 0) {
-	finallyToken = NULL;
-    } else if (numWords == 2) {
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 7
-		|| strncmp(tokenPtr[1].start, "finally", 7)) {
-	    goto failedToCompile;
-	}
-	finallyToken = TokenAfter(tokenPtr);
-    } else {
-	goto failedToCompile;
-    }
-
-    /*
-     * Issue the bytecode.
-     */
-
-    if (finallyToken) {
-	result = IssueTryFinallyInstructions(interp, envPtr, bodyToken,
-		numHandlers, matchCodes, matchClauses, resultVarIndices,
-		optionVarIndices, handlerTokens, finallyToken);
-    } else {
-	result = IssueTryInstructions(interp, envPtr, bodyToken, numHandlers,
-		matchCodes, matchClauses, resultVarIndices, optionVarIndices,
-		handlerTokens);
-    }
-
-    /*
-     * Delete any temporary state and finish off.
-     */
-
-  failedToCompile:
-    if (numHandlers > 0) {
-	for (i=0 ; i<numHandlers ; i++) {
-	    if (matchClauses[i]) {
-		TclDecrRefCount(matchClauses[i]);
-	    }
-	}
-	TclStackFree(interp, optionVarIndices);
-	TclStackFree(interp, resultVarIndices);
-	TclStackFree(interp, matchCodes);
-	TclStackFree(interp, matchClauses);
-	TclStackFree(interp, handlerTokens);
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * IssueTryInstructions, IssueTryFinallyInstructions --
- *
- *	The code generators for [try]. Split from the parsing engine for
- *	reasons of developer sanity, and also split between no-finally and
- *	with-finally cases because so many of the details of generation vary
- *	between the two.
- *
- *	The macros below make the instruction issuing easier to follow.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-IssueTryInstructions(
-    Tcl_Interp *interp,
-    CompileEnv *envPtr,
-    Tcl_Token *bodyToken,
-    int numHandlers,
-    int *matchCodes,
-    Tcl_Obj **matchClauses,
-    int *resultVars,
-    int *optionVars,
-    Tcl_Token **handlerTokens)
-{
-    DefineLineInformation;	/* TIP #280 */
-    int range, resultVar, optionsVar;
-    int i, j, len, forwardsNeedFixing = 0;
-    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
-    char buf[TCL_INTEGER_SPACE];
-
-    resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
-    optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
-    if (resultVar < 0 || optionsVar < 0) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Compile the body, trapping any error in it so that we can trap on it
-     * and/or run a finally clause. Note that there must be at least one
-     * on/trap clause; when none is present, this whole function is not called
-     * (and it's never called when there's a finally clause).
-     */
-
-    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
-    OP4(				BEGIN_CATCH4, range);
-    ExceptionRangeStarts(envPtr, range);
-    BODY(				bodyToken, 1);
-    ExceptionRangeEnds(envPtr, range);
-    PUSH(				"0");
-    OP4(				REVERSE, 2);
-    OP1(				JUMP1, 4);
-    ExceptionRangeTarget(envPtr, range, catchOffset);
-    OP(					PUSH_RETURN_CODE);
-    OP(					PUSH_RESULT);
-    OP(					PUSH_RETURN_OPTIONS);
-    OP(					END_CATCH);
-    STORE(				optionsVar);
-    OP(					POP);
-    STORE(				resultVar);
-    OP(					POP);
-
-    /*
-     * Now we handle all the registered 'on' and 'trap' handlers in order.
-     * For us to be here, there must be at least one handler.
-     *
-     * Slight overallocation, but reduces size of this function.
-     */
-
-    addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
-    forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
-
-    for (i=0 ; i<numHandlers ; i++) {
-	sprintf(buf, "%d", matchCodes[i]);
-	OP(				DUP);
-	PUSH(				buf);
-	OP(				EQ);
-	JUMP(notCodeJumpSource,		JUMP_FALSE4);
-	if (matchClauses[i]) {
-	    Tcl_ListObjLength(NULL, matchClauses[i], &len);
-
-	    /*
-	     * Match the errorcode according to try/trap rules.
-	     */
-
-	    LOAD(			optionsVar);
-	    PUSH(			"-errorcode");
-	    OP4(			DICT_GET, 1);
-	    OP44(			LIST_RANGE_IMM, 0, len-1);
-	    PUSH(			TclGetString(matchClauses[i]));
-	    OP(				STR_EQ);
-	    JUMP(notECJumpSource,	JUMP_FALSE4);
-	} else {
-	    notECJumpSource = -1; /* LINT */
-	}
-	OP(				POP);
-
-	/*
-	 * There is no finally clause, so we can avoid wrapping a catch
-	 * context around the handler. That simplifies what instructions need
-	 * to be issued a lot since we can let errors just fall through.
-	 */
-
-	if (resultVars[i] >= 0) {
-	    LOAD(			resultVar);
-	    STORE(			resultVars[i]);
-	    OP(				POP);
-	    if (optionVars[i] >= 0) {
-		LOAD(			optionsVar);
-		STORE(			optionVars[i]);
-		OP(			POP);
-	    }
-	}
-	if (!handlerTokens[i]) {
-	    forwardsNeedFixing = 1;
-	    JUMP(forwardsToFix[i],	JUMP4);
-	} else {
-	    forwardsToFix[i] = -1;
-	    if (forwardsNeedFixing) {
-		forwardsNeedFixing = 0;
-		for (j=0 ; j<i ; j++) {
-		    if (forwardsToFix[j] == -1) {
-			continue;
-		    }
-		    FIXJUMP(forwardsToFix[j]);
-		    forwardsToFix[j] = -1;
-		}
-	    }
-	    BODY(			handlerTokens[i], 5+i*4);
-	}
-
-	JUMP(addrsToFix[i],		JUMP4);
-	if (matchClauses[i]) {
-	    FIXJUMP(notECJumpSource);
-	}
-	FIXJUMP(notCodeJumpSource);
-    }
-
-    /*
-     * Drop the result code since it didn't match any clause, and reissue the
-     * exception. Note also that INST_RETURN_STK can proceed to the next
-     * instruction.
-     */
-
-    OP(					POP);
-    LOAD(				optionsVar);
-    LOAD(				resultVar);
-    OP(					RETURN_STK);
-
-    /*
-     * Fix all the jumps from taken clauses to here (which is the end of the
-     * [try]).
-     */
-
-    for (i=0 ; i<numHandlers ; i++) {
-	FIXJUMP(addrsToFix[i]);
-    }
-    TclStackFree(interp, forwardsToFix);
-    TclStackFree(interp, addrsToFix);
-    return TCL_OK;
-}
-
-static int
-IssueTryFinallyInstructions(
-    Tcl_Interp *interp,
-    CompileEnv *envPtr,
-    Tcl_Token *bodyToken,
-    int numHandlers,
-    int *matchCodes,
-    Tcl_Obj **matchClauses,
-    int *resultVars,
-    int *optionVars,
-    Tcl_Token **handlerTokens,
-    Tcl_Token *finallyToken)	/* Not NULL */
-{
-    DefineLineInformation;	/* TIP #280 */
-    int savedStackDepth = envPtr->currStackDepth;
-    int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0;
-    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
-    char buf[TCL_INTEGER_SPACE];
-
-    resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
-    optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
-    if (resultVar < 0 || optionsVar < 0) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Compile the body, trapping any error in it so that we can trap on it
-     * (if any trap matches) and run a finally clause.
-     */
-
-    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
-    OP4(				BEGIN_CATCH4, range);
-    ExceptionRangeStarts(envPtr, range);
-    BODY(				bodyToken, 1);
-    ExceptionRangeEnds(envPtr, range);
-    PUSH(				"0");
-    OP4(				REVERSE, 2);
-    OP1(				JUMP1, 4);
-    ExceptionRangeTarget(envPtr, range, catchOffset);
-    OP(					PUSH_RETURN_CODE);
-    OP(					PUSH_RESULT);
-    OP(					PUSH_RETURN_OPTIONS);
-    OP(					END_CATCH);
-    STORE(				optionsVar);
-    OP(					POP);
-    STORE(				resultVar);
-    OP(					POP);
-    envPtr->currStackDepth = savedStackDepth + 1;
-
-    /*
-     * Now we handle all the registered 'on' and 'trap' handlers in order.
-     */
-
-    if (numHandlers) {
-	/*
-	 * Slight overallocation, but reduces size of this function.
-	 */
-
-	addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
-	forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
-
-	for (i=0 ; i<numHandlers ; i++) {
-	    sprintf(buf, "%d", matchCodes[i]);
-	    OP(				DUP);
-	    PUSH(			buf);
-	    OP(				EQ);
-	    JUMP(notCodeJumpSource,	JUMP_FALSE4);
-	    if (matchClauses[i]) {
-		Tcl_ListObjLength(NULL, matchClauses[i], &len);
-
-		/*
-		 * Match the errorcode according to try/trap rules.
-		 */
-
-		LOAD(			optionsVar);
-		PUSH(			"-errorcode");
-		OP4(			DICT_GET, 1);
-		OP44(			LIST_RANGE_IMM, 0, len-1);
-		PUSH(			TclGetString(matchClauses[i]));
-		OP(			STR_EQ);
-		JUMP(notECJumpSource,	JUMP_FALSE4);
-	    } else {
-		notECJumpSource = -1; /* LINT */
-	    }
-
-	    /*
-	     * There is a finally clause, so we need a fairly complex sequence
-	     * of instructions to deal with an on/trap handler because we must
-	     * call the finally handler *and* we need to substitute the result
-	     * from a failed trap for the result from the main script.
-	     */
-
-	    if (resultVars[i] >= 0 || handlerTokens[i]) {
-		range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
-		OP4(			BEGIN_CATCH4, range);
-		ExceptionRangeStarts(envPtr, range);
-	    }
-	    if (resultVars[i] >= 0) {
-		LOAD(			resultVar);
-		STORE(			resultVars[i]);
-		OP(			POP);
-		if (optionVars[i] >= 0) {
-		    LOAD(		optionsVar);
-		    STORE(		optionVars[i]);
-		    OP(			POP);
-		}
-
-		if (!handlerTokens[i]) {
-		    /*
-		     * No handler. Will not be the last handler (that is a
-		     * condition that is checked by the caller). Chain to the
-		     * next one.
-		     */
-
-		    ExceptionRangeEnds(envPtr, range);
-		    OP(			END_CATCH);
-		    forwardsNeedFixing = 1;
-		    JUMP(forwardsToFix[i], JUMP4);
-		    goto finishTrapCatchHandling;
-		}
-	    } else if (!handlerTokens[i]) {
-		/*
-		 * No handler. Will not be the last handler (that condition is
-		 * checked by the caller). Chain to the next one.
-		 */
-
-		forwardsNeedFixing = 1;
-		JUMP(forwardsToFix[i],	JUMP4);
-		goto endOfThisArm;
-	    }
-
-	    /*
-	     * Got a handler. Make sure that any pending patch-up actions from
-	     * previous unprocessed handlers are dealt with now that we know
-	     * where they are to jump to.
-	     */
-
-	    if (forwardsNeedFixing) {
-		forwardsNeedFixing = 0;
-		OP1(			JUMP1, 7);
-		for (j=0 ; j<i ; j++) {
-		    if (forwardsToFix[j] == -1) {
-			continue;
-		    }
-		    FIXJUMP(forwardsToFix[j]);
-		    forwardsToFix[j] = -1;
-		}
-		OP4(			BEGIN_CATCH4, range);
-	    }
-	    BODY(			handlerTokens[i], 5+i*4);
-	    ExceptionRangeEnds(envPtr, range);
-	    OP(				PUSH_RETURN_OPTIONS);
-	    OP4(			REVERSE, 2);
-	    OP1(			JUMP1, 4);
-	    forwardsToFix[i] = -1;
-
-	    /*
-	     * Error in handler or setting of variables; replace the stored
-	     * exception with the new one. Note that we only push this if we
-	     * have either a body or some variable setting here. Otherwise
-	     * this code is unreachable.
-	     */
-
-	finishTrapCatchHandling:
-	    ExceptionRangeTarget(envPtr, range, catchOffset);
-	    OP(				PUSH_RETURN_OPTIONS);
-	    OP(				PUSH_RESULT);
-	    OP(				END_CATCH);
-	    STORE(			resultVar);
-	    OP(				POP);
-	    STORE(			optionsVar);
-	    OP(				POP);
-
-	endOfThisArm:
-	    if (i+1 < numHandlers) {
-		JUMP(addrsToFix[i],	JUMP4);
-	    }
-	    if (matchClauses[i]) {
-		FIXJUMP(notECJumpSource);
-	    }
-	    FIXJUMP(notCodeJumpSource);
-	}
-
-	/*
-	 * Fix all the jumps from taken clauses to here (the start of the
-	 * finally clause).
-	 */
-
-	for (i=0 ; i<numHandlers-1 ; i++) {
-	    FIXJUMP(addrsToFix[i]);
-	}
-	TclStackFree(interp, forwardsToFix);
-	TclStackFree(interp, addrsToFix);
-    }
-
-    /*
-     * Drop the result code.
-     */
-
-    OP(					POP);
-    envPtr->currStackDepth = savedStackDepth;
-
-    /*
-     * Process the finally clause (at last!) Note that we do not wrap this in
-     * error handlers because we would just rethrow immediately anyway. Then
-     * (on normal success) we reissue the exception. Note also that
-     * INST_RETURN_STK can proceed to the next instruction; that'll be the
-     * next command (or some inter-command manipulation).
-     */
-
-    BODY(				finallyToken, 3 + 4*numHandlers);
-    OP(					POP);
-    LOAD(				optionsVar);
-    LOAD(				resultVar);
-    OP(					RETURN_STK);
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileUnsetCmd --
- *
- *	Procedure called to compile the "unset" 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 "unset" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileUnsetCmd(
-    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 isScalar, simpleVarName, localIndex, numWords, flags, i;
-    Tcl_Obj *leadingWord;
-    DefineLineInformation;	/* TIP #280 */
-
-    numWords = parsePtr->numWords-1;
-    flags = 1;
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    leadingWord = Tcl_NewObj();
-    if (TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
-	int len;
-	const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
-
-	if (len == 11 && !strncmp("-nocomplain", bytes, 11)) {
-	    flags = 0;
-	    varTokenPtr = TokenAfter(varTokenPtr);
-	    numWords--;
-	} else if (len == 2 && !strncmp("--", bytes, 2)) {
-	    varTokenPtr = TokenAfter(varTokenPtr);
-	    numWords--;
-	}
-    } else {
-	/*
-	 * Cannot guarantee that the first word is not '-nocomplain' at
-	 * evaluation with reasonable effort, so spill to interpreted version.
-	 */
-
-	TclDecrRefCount(leadingWord);
-	return TCL_ERROR;
-    }
-    TclDecrRefCount(leadingWord);
-
-    for (i=0 ; i<numWords ; i++) {
-	/*
-	 * 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.
-	 */
-
-	PushVarNameWord(interp, varTokenPtr, envPtr, 0,
-		&localIndex, &simpleVarName, &isScalar, 1);
-
-	/*
-	 * Emit instructions to unset the variable.
-	 */
-
-	if (!simpleVarName) {
-	    TclEmitInstInt1(	INST_UNSET_STK, flags,		envPtr);
-	} else if (isScalar) {
-	    if (localIndex < 0) {
-		TclEmitInstInt1(INST_UNSET_STK, flags,		envPtr);
-	    } else {
-		TclEmitInstInt1(INST_UNSET_SCALAR, flags,	envPtr);
-		TclEmitInt4(			   localIndex,	envPtr);
-	    }
-	} else {
-	    if (localIndex < 0) {
-		TclEmitInstInt1(INST_UNSET_ARRAY_STK, flags,	envPtr);
-	    } else {
-		TclEmitInstInt1(INST_UNSET_ARRAY, flags,	envPtr);
-		TclEmitInt4(			  localIndex,	envPtr);
-	    }
-	}
-
-	varTokenPtr = TokenAfter(varTokenPtr);
-    }
-    PushLiteral(envPtr, "", 0);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCompileWhileCmd --
- *
- *	Procedure called to compile the "while" 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 "while" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-int
-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, range, code, boolVal;
-    int savedStackDepth = envPtr->currStackDepth;
-    int loopMayEnd = 1;		/* This is set to 0 if it is recognized as an
-				 * infinite loop. */
-    Tcl_Obj *boolObj;
-    DefineLineInformation;	/* TIP #280 */
-
-    if (parsePtr->numWords != 3) {
-	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" {}".
-     *
-     * Bail out also if the body expression requires substitutions in order to
-     * insure correct behaviour [Bug 219166]
-     */
-
-    testTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    bodyTokenPtr = TokenAfter(testTokenPtr);
-
-    if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
-	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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);
-    TclDecrRefCount(boolObj);
-    if (code == TCL_OK) {
-	if (boolVal) {
-	    /*
-	     * It is an infinite loop; flag it so that we generate a more
-	     * efficient body.
-	     */
-
-	    loopMayEnd = 0;
-	} else {
-	    /*
-	     * 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.
-     */
-
-    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
-
-    /*
-     * Jump to the evaluation of the condition. This code uses the "loop
-     * rotation" optimisation (which eliminates one branch from the loop).
-     * "while cond body" produces then:
-     *       goto A
-     *    B: body                : bodyCodeOffset
-     *    A: cond -> result      : testCodeOffset, continueOffset
-     *       if (result) goto B
-     *
-     * The infinite loop "while 1 body" produces:
-     *    B: body                : all three offsets here
-     *       goto B
-     */
-
-    if (loopMayEnd) {
-	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
-		&jumpEvalCondFixup);
-	testCodeOffset = 0;	/* Avoid compiler warning. */
-    } else {
-	/*
-	 * 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 = ExceptionRangeStarts(envPtr, range);
-    CompileBody(envPtr, bodyTokenPtr, interp);
-    ExceptionRangeEnds(envPtr, range);
-    envPtr->currStackDepth = savedStackDepth + 1;
-    TclEmitOpcode(INST_POP, envPtr);
-
-    /*
-     * Compile the test expression then emit the conditional jump that
-     * terminates the while. We already know it's a simple word.
-     */
-
-    if (loopMayEnd) {
-	testCodeOffset = CurrentOffset(envPtr);
-	jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
-	if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
-	    bodyCodeOffset += 3;
-	    testCodeOffset += 3;
-	}
-	envPtr->currStackDepth = savedStackDepth;
-	SetLineInformation(1);
-	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
-	envPtr->currStackDepth = savedStackDepth + 1;
-
-	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
-	if (jumpDist > 127) {
-	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
-	} else {
-	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
-	}
-    } else {
-	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;
-    ExceptionRangeTarget(envPtr, range, breakOffset);
-
-    /*
-     * The while command's result is an empty string.
-     */
-
-  pushResult:
-    envPtr->currStackDepth = savedStackDepth;
-    PushLiteral(envPtr, "", 0);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PushVarName --
- *
- *	Procedure used in the compiling where pushing a variable name is
- *	necessary (append, lappend, set).
- *
- * 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 "set" command at
- *	runtime.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PushVarName(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Token *varTokenPtr,	/* Points to a variable token. */
-    CompileEnv *envPtr,		/* Holds resulting instructions. */
-    int flags,			/* 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;
-    Tcl_Token *elemTokenPtr = NULL;
-    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.
-     */
-
-    simpleVarName = 0;
-    name = elName = NULL;
-    nameChars = elNameChars = 0;
-    localIndex = -1;
-
-    /*
-     * 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
-     *    set {x($foo)} 5
-     * which raises an undefined var error if we are not careful here.
-     */
-
-    if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) &&
-	    (varTokenPtr->start[0] != '{')) {
-	/*
-	 * 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] == ')') {
-	    /*
-	     * last char is ')' => potential array reference.
-	     */
-
-	    for (i=0,p=name ; i<nameChars ; i++,p++) {
-		if (*p == '(') {
-		    elName = p + 1;
-		    elNameChars = nameChars - i - 2;
-		    nameChars = i;
-		    break;
-		}
-	    }
-
-	    if ((elName != NULL) && elNameChars) {
-		/*
-		 * An array element, the element name is a simple string:
-		 * assemble the corresponding token.
-		 */
-
-		elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
-		allocedTokens = 1;
-		elemTokenPtr->type = TCL_TOKEN_TEXT;
-		elemTokenPtr->start = elName;
-		elemTokenPtr->size = elNameChars;
-		elemTokenPtr->numComponents = 0;
-		elemTokenCount = 1;
-	    }
-	}
-    } 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] == ')')) {
-	/*
-	 * 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) {
-	    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.
-	     */
-
-	    if (varTokenPtr[n].size == 1) {
-		n--;
-	    } else {
-		varTokenPtr[n].size--;
-		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;
-
-	    if (remainingChars) {
-		/*
-		 * Make a first token with the extra characters in the first
-		 * token.
-		 */
-
-		elemTokenPtr = 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(elemTokenPtr+1, varTokenPtr+2,
-			(n-1) * sizeof(Tcl_Token));
-	    } else {
-		/*
-		 * Use the already available tokens.
-		 */
-
-		elemTokenPtr = &varTokenPtr[2];
-		elemTokenCount = n - 1;
-	    }
-	}
-    }
-
-    if (simpleVarName) {
-	/*
-	 * See whether name has any namespace separators (::'s).
-	 */
-
-	int hasNsQualifiers = 0;
-
-	for (i = 0, p = name;  i < nameChars;  i++, p++) {
-	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
-		hasNsQualifiers = 1;
-		break;
-	    }
-	}
-
-	/*
-	 * 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 (!hasNsQualifiers) {
-	    localIndex = TclFindCompiledLocal(name, nameChars,
-		    1, envPtr);
-	    if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
-		/*
-		 * We'll push the name.
-		 */
-
-		localIndex = -1;
-	    }
-	}
-	if (localIndex < 0) {
-	    PushLiteral(envPtr, name, nameChars);
-	}
-
-	/*
-	 * Compile the element script, if any.
-	 */
-
-	if (elName != NULL) {
-	    if (elNameChars) {
-		envPtr->line = line;
-		envPtr->clNext = clNext;
-		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
-			envPtr);
-	    } else {
-		PushLiteral(envPtr, "", 0);
-	    }
-	}
-    } else {
-	/*
-	 * The var name isn't simple: compile and push it.
-	 */
-
-	envPtr->line = line;
-	envPtr->clNext = clNext;
-	CompileTokens(envPtr, varTokenPtr, interp);
-    }
-
-    if (removedParen) {
-	varTokenPtr[removedParen].size++;
-    }
-    if (allocedTokens) {
-	TclStackFree(interp, elemTokenPtr);
-    }
-    *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);
-	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;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 4212b6d..6bac221 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1,2114 +1,578 @@
-/*
+/* 
  * tclCompExpr.c --
  *
- *	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::+ .
+ *	This file contains the code to compile Tcl expressions.
  *
- * Contributions from Don Porter, NIST, 2006-2007. (not subject to US copyright)
+ * Copyright (c) 1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-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"
-#include "tclCompile.h"		/* CompileEnv */
+#include "tclCompile.h"
 
 /*
- * 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.
+ * 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.
  */
 
-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;
+#ifndef TCL_GENERIC_ONLY
+#include "tclPort.h"
+#else
+#define NO_ERRNO_H
+#endif
 
-/*
- * 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.
- */
-
-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. */
-};
+#ifdef NO_ERRNO_H
+extern int errno;			/* Use errno from tclExecute.c. */
+#define ERANGE 34
+#endif
 
 /*
- * 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.
+ * Boolean variable that controls whether expression compilation tracing
+ * is enabled.
  */
 
-#define IsOperator(l)	((l) >= 0)
-#define NotOperator(l)	((l) < 0)
+#ifdef TCL_COMPILE_DEBUG
+static int traceExprComp = 0;
+#endif /* TCL_COMPILE_DEBUG */
 
 /*
- * 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:
- */
-
-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 */
-};
-
-/*
- * 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.
+ * The ExprInfo structure describes the state of compiling an expression.
+ * A pointer to an ExprInfo record is passed among the routines in
+ * this module.
  */
 
-/*
- * 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
+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;
 
 /*
- * 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.
+ * 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.
  */
 
-#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. */
+#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
 
 /*
- * 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.
+ * Table describing the expression operators. Entries in this table must
+ * correspond to the definitions of numeric codes for operators just above.
  */
 
-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, "!", "~" */
+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}
 };
 
 /*
- * 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.
+ * Hashtable used to map the names of expression operators to the index
+ * of their OperatorDesc description.
  */
 
-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*/
-};
+static Tcl_HashTable opHashTable;
 
 /*
- * A table mapping lexemes to bytecode instructions, used by CompileExprTree().
+ * Declarations for local procedures to this file:
  */
 
-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*/
-};
-
-/*
- * A table mapping a byte value to the corresponding lexeme for use by
- * ParseLexeme().
- */
-
-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;
+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));
 
 /*
- * Declarations for local functions to this file:
+ * Macro used to debug the execution of the expression compiler.
  */
 
-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);
+#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 */
 
 /*
  *----------------------------------------------------------------------
  *
- * ParseExpr --
+ * TclCompileExpr --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	If the string is successfully parsed as a valid Tcl expression, TCL_OK
- *	is returned, and data about the expression structure is written to 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.
+ *	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.
  *
  * Side effects:
- *	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.
+ *	Adds instructions to envPtr to evaluate the expression at runtime.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
+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. */
 {
-    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. */
+    ExprInfo info;
+    Tcl_Parse parse;
+    Tcl_HashEntry *hPtr;
+    int new, i, code;
 
     /*
-     * These variables control generation of the error message.
+     * If this is the first time we've been called, initialize the table
+     * of expression operators.
      */
 
-    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 *errCode = NULL;	/* The detail word of the errorCode list, or
-				 * NULL to indicate that no changes to the
-				 * errorCode are to be done. */
-    const char *subErrCode = NULL;
-				/* Extra information for use in generating the
-				 * errorCode. */
-    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 = attemptckalloc(nodesAvailable * sizeof(OpNode));
-    if (nodes == NULL) {
-	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
-	errCode = "NOMEM";
-	goto error;
+    if (numBytes < 0) {
+	numBytes = (script? strlen(script) : 0);
     }
-
-    /*
-     * 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++;
-
-    /*
-     * 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.
-     */
-
-    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 = attemptckrealloc(nodes, size * sizeof(OpNode));
-	    } while ((newPtr == NULL)
-		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
-	    if (newPtr == NULL) {
-		TclNewLiteralStringObj(msg,
-			"not enough memory to parse expression");
-		errCode = "NOMEM";
-		goto error;
-	    }
-	    nodesAvailable = size;
-	    nodes = newPtr;
-	}
-	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) {
-	    int b;
-
-	    switch (lexeme) {
-	    case INVALID:
-		msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
-			scanned, start);
-		errCode = "BADCHAR";
-		goto error;
-	    case INCOMPLETE:
-		msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
-			scanned, start);
-		errCode = "PARTOP";
-		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;
-
-		    /*
-		     * 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.
-		     */
-
-		    Tcl_ListObjAppendElement(NULL, funcList, literal);
-		} else 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) ? "" : "...");
-		    errCode = "BAREWORD";
-		    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)) {
-			    switch (start[1]) {
-			    case 'b':
-				Tcl_AppendToObj(post,
-					" (invalid binary number?)", -1);
-				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
-				errCode = "BADNUMBER";
-				subErrCode = "BINARY";
-				break;
-			    case 'o':
-				Tcl_AppendToObj(post,
-					" (invalid octal number?)", -1);
-				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
-				errCode = "BADNUMBER";
-				subErrCode = "OCTAL";
-				break;
-			    default:
-				if (isdigit(UCHAR(start[1]))) {
-				    Tcl_AppendToObj(post,
-					    " (invalid octal number?)", -1);
-				    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
-				    errCode = "BADNUMBER";
-				    subErrCode = "OCTAL";
-				}
-				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) {
-	case LEAF: {
-	    /*
-	     * 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.
-	     */
-
-	    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);
-		errCode = "MISSING";
-		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 \"$\"");
-		    errCode = "BADCHAR";
-		    goto error;
-		}
-		scanned = tokenPtr->size;
-		break;
-
-	    case SCRIPT: {
-		Tcl_Parse *nestedPtr =
-			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[0] == ']')
-			    && !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;
-			errCode = "UNBALANCED";
-			break;
-		    }
-		}
-		TclStackFree(interp, nestedPtr);
-		end = start;
-		start = tokenPtr->start;
-		scanned = end - start;
-		tokenPtr->size = scanned;
-		parsePtr->numTokens++;
-		break;
-	    }			/* SCRIPT case */
-	    }
-	    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;
-		if (parsePtr->incomplete) {
-		    errCode = "UNBALANCED";
-		}
-		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;
-		errCode = "MISSING";
-		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
-			 * will 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;
-		    errCode = "EMPTY";
-		    goto error;
-		}
-
-		if (nodePtr[-1].precedence > precedence) {
-		    if (nodePtr[-1].lexeme == OPEN_PAREN) {
-			TclNewLiteralStringObj(msg, "unbalanced open paren");
-			parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
-			errCode = "UNBALANCED";
-		    } else if (nodePtr[-1].lexeme == COMMA) {
-			msg = Tcl_ObjPrintf(
-				"missing function argument at %s", mark);
-			scanned = 0;
-			insertMark = 1;
-			errCode = "MISSING";
-		    } else if (nodePtr[-1].lexeme == START) {
-			TclNewLiteralStringObj(msg, "empty expression");
-			errCode = "EMPTY";
-		    }
-		} else if (lexeme == CLOSE_PAREN) {
-		    TclNewLiteralStringObj(msg, "unbalanced close paren");
-		    errCode = "UNBALANCED";
-		} 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;
-		    errCode = "UNBALANCED";
-		}
-		if (msg == NULL) {
-		    msg = Tcl_ObjPrintf("missing operand at %s", mark);
-		    scanned = 0;
-		    insertMark = 1;
-		    errCode = "MISSING";
-		}
-		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;
-		    errCode = "UNBALANCED";
-		    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;
-		    errCode = "MISSING";
-		    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 \"?\"");
-		    errCode = "SURPRISE";
-		    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");
-		    errCode = "UNBALANCED";
-		    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");
-		    errCode = "SURPRISE";
-		    goto error;
+    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);
 		}
 	    }
-
-	    /* Operator ":" may only be right operand of "?" */
-	    if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
-		TclNewLiteralStringObj(msg,
-			"unexpected operator \":\" without preceding \"?\"");
-		errCode = "SURPRISE";
-		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 */
+	    opTableInitialized = 1;
+	}
+	Tcl_MutexUnlock(&opMutex);
+    }
 
     /*
-     * 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.
+     * Initialize the structure containing information abvout this
+     * expression compilation.
      */
 
-  error:
-    if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
-	parsePtr->errorType = TCL_PARSE_SYNTAX;
-    }
+    info.interp = interp;
+    info.parsePtr = &parse;
+    info.expr = script;
+    info.lastChar = (script + numBytes); 
+    info.hasOperators = 0;
 
     /*
-     * Free any partial parse tree we've built.
+     * Parse the expression then compile it.
      */
 
-    if (nodes != NULL) {
-	ckfree(nodes);
+    code = Tcl_ParseExpr(interp, script, numBytes, &parse);
+    if (code != TCL_OK) {
+	goto done;
     }
 
-    if (interp == NULL) {
-	/*
-	 * Nowhere to report an error message, so just free it.
-	 */
-
-	if (msg) {
-	    Tcl_DecrRefCount(msg);
-	}
-    } else {
-	/*
-	 * Construct the complete error message. Start with the simple error
-	 * message, pulled from the interp result if necessary...
-	 */
-
-	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) ? "" : "...");
+#ifdef TCL_TIP280
+    /* TIP #280 : Track Lines within the expression */
+    TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start);
+#endif
 
-	/*
-	 * 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) ? "" : "..."));
-	if (errCode) {
-	    Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
-		    subErrCode, NULL);
-	}
+    code = CompileSubExpr(parse.tokenPtr, &info, envPtr);
+    if (code != TCL_OK) {
+	Tcl_FreeParse(&parse);
+	goto done;
     }
-
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ConvertTreeToTokens --
- *
- *	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:
- *	The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the
- *	parsed expression.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ConvertTreeToTokens(
-    const char *start,
-    int numBytes,
-    OpNode *nodes,
-    Tcl_Token *tokenPtr,
-    Tcl_Parse *parsePtr)
-{
-    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++;
-
+    
+    if (!info.hasOperators) {
 	/*
-	 * Handle next child node or leaf.
+	 * 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.
 	 */
-
-	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;
-	}
+	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
     }
+    Tcl_FreeParse(&parse);
+
+    done:
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ParseExpr --
+ * TclFinalizeCompilation --
  *
- *	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.
+ *	Clean up the compilation environment so it can later be
+ *	properly reinitialized. This procedure is called by Tcl_Finalize().
  *
  * Results:
- *	If the string is successfully parsed as a valid Tcl expression, TCL_OK
- *	is returned, and data about the expression structure is written to
- *	*parsePtr. If the string cannot be parsed as a valid Tcl expression,
- *	TCL_ERROR is returned, and if interp is non-NULL, an error message is
- *	written to interp.
+ *	None.
  *
  * Side effects:
- *	If there is insufficient space in parsePtr to hold all the information
- *	about the expression, then additional space is malloc-ed. If the
- *	function returns TCL_OK then the caller must eventually invoke
- *	Tcl_FreeParse to release any additional space that was allocated.
+ *	Cleans up the compilation environment. At the moment, just the
+ *	table of expression operators is freed.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
+void
+TclFinalizeCompilation()
 {
-    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 = 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_MutexLock(&opMutex);
+    if (opTableInitialized) {
+        Tcl_DeleteHashTable(&opHashTable);
+        opTableInitialized = 0;
     }
-
-    Tcl_FreeParse(exprParsePtr);
-    TclStackFree(interp, exprParsePtr);
-    ckfree(opTree);
-    return code;
+    Tcl_MutexUnlock(&opMutex);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ParseLexeme --
+ * CompileSubExpr --
  *
- *	Parse a single lexeme from the start of a string, scanning no more
- *	than numBytes bytes.
+ *	Given a pointer to a TCL_TOKEN_SUB_EXPR token describing a
+ *	subexpression, this procedure emits instructions to evaluate the
+ *	subexpression at runtime.
  *
  * Results:
- *	Returns the number of bytes scanned to produce the lexeme.
+ *	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.
  *
  * Side effects:
- *	Code identifying lexeme parsed is writen to *lexemePtr.
+ *	Adds instructions to envPtr to evaluate the subexpression.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-ParseLexeme(
-    const char *start,		/* Start of lexeme to parse. */
-    int numBytes,		/* Number of bytes in string. */
-    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
-				 * storage. */
-    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
-				   storage, if non-NULL. */
+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. */
 {
-    const char *end;
-    int scanned;
-    Tcl_UniChar ch;
-    Tcl_Obj *literal = NULL;
-    unsigned char byte;
-
-    if (numBytes == 0) {
-	*lexemePtr = END;
-	return 0;
+    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);
     }
-    byte = UCHAR(*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;
+    code = TCL_OK;
 
-    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;
+    /*
+     * 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;
 	    }
-	}
-	*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_TEXT:
+	    if (tokenPtr->size > 0) {
+		objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
+	                tokenPtr->size);
+	    } else {
+		objIndex = TclRegisterNewLiteral(envPtr, "", 0);
 	    }
-	}
-	*lexemePtr = GREATER;
-	return 1;
-
-    case 'i':
-	if ((numBytes > 1) && (start[1] == 'n')
-		&& ((numBytes == 2) || !isalpha(UCHAR(start[2])))) {
+	    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;
+	    }
+	    tokenPtr += (tokenPtr->numComponents + 1);
+	    break;
+	    
+        case TCL_TOKEN_SUB_EXPR:
+	    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+	    if (code != TCL_OK) {
+		goto done;
+	    }
+	    tokenPtr += (tokenPtr->numComponents + 1);
+	    break;
+	    
+        case TCL_TOKEN_OPERATOR:
 	    /*
-	     * Must make this check so we can tell the difference between the
-	     * "in" operator and the "int" function name and the "infinity"
-	     * numeric value.
+	     * Look up the operator.  If the operator isn't found, treat it
+	     * as a math function.
 	     */
-
-	    *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_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;
 	    }
-	    return (end-start);
-	} else {
-	    unsigned char lexeme;
+	    Tcl_DStringFree(&opBuf);
+	    opIndex = (int) Tcl_GetHashValue(hPtr);
+	    opDescPtr = &(operatorTable[opIndex]);
 
 	    /*
-	     * 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 the operator is "normal", compile it using information
+	     * from the operator table.
 	     */
-	    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;
+
+	    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;
 		    }
+		    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;
-	    }
-
+	    
 	    /*
-	     * Otherwise, fall through and parse the whole as a bareword.
+	     * The operator requires special treatment, and is either
+	     * "+" or "-", or one of "&&", "||" or "?".
 	     */
-	}
-    }
+	    
+	    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;
 
-    if (Tcl_UtfCharComplete(start, numBytes)) {
-	scanned = Tcl_UtfToUniChar(start, &ch);
-    } else {
-	char utfBytes[TCL_UTF_MAX];
+	        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;
 
-	memcpy(utfBytes, start, (size_t) numBytes);
-	utfBytes[numBytes] = '\0';
-	scanned = Tcl_UtfToUniChar(utfBytes, &ch);
-    }
-    if (!isalnum(UCHAR(ch))) {
-	*lexemePtr = INVALID;
-	Tcl_DecrRefCount(literal);
-	return scanned;
+        default:
+	    panic("CompileSubExpr: unexpected token type %d\n",
+	            tokenPtr->type);
     }
-    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);
+
+    /*
+     * 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;
     }
-    return (end-start);
+    
+    done:
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileExpr --
+ * CompileLandOrLorExpr --
  *
- *	This procedure compiles a string containing a Tcl expression into Tcl
- *	bytecodes. 
+ *	This procedure compiles a Tcl logical and ("&&") or logical or
+ *	("||") subexpression.
  *
  * Results:
- *	None.
+ *	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.
  *
  * Side effects:
  *	Adds instructions to envPtr to evaluate the expression at runtime.
@@ -2116,718 +580,387 @@ ParseLexeme(
  *----------------------------------------------------------------------
  */
 
-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. */
+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. */
 {
-    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 = TclStackAlloc(interp, sizeof(Tcl_Parse));
-				/* Holds the Tcl_Tokens of substitutions */
+    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;
 
-    int code = ParseExpr(interp, script, numBytes, &opTree, litList,
-	    funcList, parsePtr, 0 /* parseOnly */);
+    /*
+     * Emit code for the first operand.
+     */
 
-    if (code == TCL_OK) {
-	/*
-	 * Valid parse; compile the tree.
-	 */
+    tokenPtr = exprTokenPtr+2;
+    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+    if (code != TCL_OK) {
+	goto done;
+    }
+    tokenPtr += (tokenPtr->numComponents + 1);
+
+    /*
+     * Convert the first operand to the result that Tcl requires:
+     * "0" or "1". Eventually we'll use a new instruction for this.
+     */
+    
+    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;
+    }
 
-	int objc;
-	Tcl_Obj *const *litObjv;
-	Tcl_Obj **funcObjv;
+    /*
+     * 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.
+     */
 
-	/* TIP #280 : Track Lines within the expression */
-	TclAdvanceLines(&envPtr->line, script,
-		script + TclParseAllWhiteSpace(script, numBytes));
+    TclEmitOpcode(INST_DUP, envPtr);
+    TclEmitForwardJump(envPtr,
+	    ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
+	    &shortCircuitFixup);
 
-	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 second operand.
+     */
+
+    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+    if (code != TCL_OK) {
+	goto done;
     }
+    tokenPtr += (tokenPtr->numComponents + 1);
 
-    Tcl_FreeParse(parsePtr);
-    TclStackFree(interp, parsePtr);
-    Tcl_DecrRefCount(funcList);
-    Tcl_DecrRefCount(litList);
-    ckfree(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.
- *
- *----------------------------------------------------------------------
- */
+    /*
+     * 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.
+     */
 
-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();
-    NRE_callback *rootPtr = TOP_CB(interp);
+    TclEmitOpcode(((opIndex==OP_LAND)? INST_LAND : INST_LOR), envPtr);
 
     /*
-     * 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.
+     * Now that we know the target of the forward jump, update it with the
+     * correct distance.
      */
 
-    envPtr = 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 = byteCodeObj->internalRep.otherValuePtr;
-    TclNRExecuteByteCode(interp, byteCodePtr);
-    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
-    Tcl_DecrRefCount(byteCodeObj);
+    dist = (envPtr->codeNext - envPtr->codeStart)
+	    - shortCircuitFixup.codeOffset;
+    TclFixupForwardJump(envPtr, &shortCircuitFixup, dist, 127);
+    *endPtrPtr = tokenPtr;
+
+    done:
+    envPtr->currStackDepth = savedStackDepth + 1;
     return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * CompileExprTree --
+ * CompileCondExpr --
  *
- *	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.
+ *	This procedure compiles a Tcl conditional expression:
+ *	condExpr ::= lorExpr ['?' condExpr ':' condExpr]
  *
  * Results:
- *	None.
+ *	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.
  *
  * Side effects:
  *	Adds instructions to envPtr to evaluate the expression at runtime.
- *	Consumes subtree of nodes rooted at index. Advances the pointer
- *	*litObjvPtr.
  *
  *----------------------------------------------------------------------
  */
 
-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 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. */
 {
-    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 = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		jumpPtr->depth = envPtr->currStackDepth;
-		convert = 1;
-		break;
-	    case AND:
-	    case OR:
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = TclStackAlloc(interp, sizeof(JumpList));
-		newJump->next = jumpPtr;
-		jumpPtr = newJump;
-		newJump = 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(TclRegisterNewCmdLiteral(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:
-		CLANG_ASSERT(jumpPtr);
-		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:
-
-		/* do nothing */
-		break;
-	    case FUNCTION:
-		/*
-		 * Use the numWords count we've kept to invoke the function
-		 * command with the correct number of arguments.
-		 */
-		
-		if (numWords < 255) {
-		    TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
-		} else {
-		    TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
-		}
-
-		/*
-		 * Restore any saved numWords value.
-		 */
+    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;
 
-		numWords = nodePtr->left;
-		convert = 1;
-		break;
-	    case COMMA:
-		/*
-		 * Each comma implies another function argument.
-		 */
-
-		numWords++;
-		break;
-	    case COLON:
-		CLANG_ASSERT(jumpPtr);
-		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:
-		CLANG_ASSERT(jumpPtr);
-		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) {
-		/* We're done */
+    /*
+     * Emit code for the test.
+     */
 
-		return;
-	    }
-	    nodePtr = nodes + nodePtr->p.parent;
-	    continue;
-	}
+    tokenPtr = exprTokenPtr+2;
+    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+    if (code != TCL_OK) {
+	goto done;
+    }
+    tokenPtr += (tokenPtr->numComponents + 1);
+    
+    /*
+     * Emit the jump to the "else" expression if the test was false.
+     */
+    
+    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpAroundThenFixup);
 
-	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.
-		     */
+    /*
+     * 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.
+     */
 
-		    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);
+    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);
+    }
 
-		if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
-			== TCL_OK) {
-		    int index;
-		    Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+    /*
+     * Emit an unconditional jump around the "else" condExpr.
+     */
+    
+    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
+	    &jumpAroundElseFixup);
 
-		    /*
-		     * Don't generate a string rep, but if we have one
-		     * already, then use it to share via the literal table.
-		     */
+    /*
+     * Compile the "else" expression.
+     */
 
-		    if (objPtr->bytes) {
-			Tcl_Obj *tableValue;
-
-			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
-				objPtr->length);
-			tableValue = envPtr->literalArrayPtr[index].objPtr;
-			if ((tableValue->typePtr == NULL) &&
-				(objPtr->typePtr != NULL)) {
-			    /*
-			     * Same intrep surgery as for OT_LITERAL.
-			     */
-
-			    tableValue->typePtr = objPtr->typePtr;
-			    tableValue->internalRep = objPtr->internalRep;
-			    objPtr->typePtr = NULL;
-			}
-		    } else {
-			index = TclAddLiteralObj(envPtr, objPtr, NULL);
-		    }
-		    TclEmitPush(index, envPtr);
-		} else {
-		    TclCompileSyntaxError(interp, envPtr);
-		}
-		Tcl_RestoreInterpState(interp, save);
-		convert = 0;
-	    } else {
-		nodePtr = nodes + next;
-	    }
-	}
+    envPtr->currStackDepth = savedStackDepth;
+    elseCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+    infoPtr->hasOperators = 0;
+    code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+    if (code != TCL_OK) {
+	goto done;
     }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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:
- *	A standard Tcl return code and result left in interp.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclSingleOpCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    TclOpCmdClientData *occdPtr = 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 += (tokenPtr->numComponents + 1);
+    if (!infoPtr->hasOperators) {
+	TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
     }
 
-    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;
+    /*
+     * Fix up the second jump around the "else" expression.
+     */
+
+    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;
     }
-    nodes[1].right = OT_LITERAL;
-    nodes[1].p.parent = 0;
+	
+    /*
+     * 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;
 
-    return ExecConstantExprTree(interp, nodes, 0, &litObjv);
+    done:
+    envPtr->currStackDepth = savedStackDepth + 1;
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * 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.
+ * CompileMathFuncCall --
+ *
+ *	This procedure compiles a call on a math function in an expression:
+ *	mathFuncCall ::= funcName '(' [condExpr {',' condExpr}] ')'
  *
  * Results:
- *	A standard Tcl return code and result left in interp.
+ *	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.
  *
  * Side effects:
- *	None.
+ *	Adds instructions to envPtr to evaluate the math function at
+ *	runtime.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclSortingOpCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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 code = TCL_OK;
-
-    if (objc < 3) {
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
-    } else {
-	TclOpCmdClientData *occdPtr = clientData;
-	Tcl_Obj **litObjv = TclStackAlloc(interp,
-		2 * (objc-2) * sizeof(Tcl_Obj *));
-	OpNode *nodes = 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];
+    Tcl_Interp *interp = infoPtr->interp;
+    Interp *iPtr = (Interp *) interp;
+    MathFunc *mathFuncPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_Token *tokenPtr, *afterSubexprPtr;
+    int code, i;
 
-	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;
-
-	nodes[0].right = lastAnd;
-	nodes[lastAnd].p.parent = 0;
-
-	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
+    /*
+     * Look up the MathFunc record for the function.
+     */
 
-	TclStackFree(interp, nodes);
-	TclStackFree(interp, litObjv);
+    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;
     }
-    return code;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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:
- *	A standard Tcl return code and result left in interp.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
+    mathFuncPtr = (MathFunc *) Tcl_GetHashValue(hPtr);
 
-int
-TclVariadicOpCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    TclOpCmdClientData *occdPtr = clientData;
-    unsigned char lexeme;
-    int code;
+    /*
+     * If not a builtin function, push an object with the function's name.
+     */
 
-    if (objc < 2) {
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
-	return TCL_OK;
+    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;
-	}
-
-	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);
+    /*
+     * Compile any arguments for the function.
+     */
 
-	Tcl_DecrRefCount(litObjv[decrMe]);
-	return code;
-    } else {
-	Tcl_Obj *const *litObjv = objv + 1;
-	OpNode *nodes = 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 = 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;
 	    }
+	    tokenPtr += (tokenPtr->numComponents + 1);
 	}
-	nodes[0].right = lastOp;
-	nodes[lastOp].p.parent = 0;
+	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.
+     */
 
-	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);
+    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.
+	 */
 
-	TclStackFree(interp, nodes);
-	return code;
+	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;
+
+    done:
+    return code;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * 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.
+ * 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.
  *
  * Results:
- *	A standard Tcl return code and result left in interp.
+ *	None.
  *
  * Side effects:
- *	None.
+ *	Sets the interpreter result to an error message describing the
+ *	expression that was being compiled when the error occurred.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclNoIdentOpCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+static void
+LogSyntaxError(infoPtr)
+    ExprInfo *infoPtr;		/* Describes the compilation state for the
+				 * expression being compiled. */
 {
-    TclOpCmdClientData *occdPtr = clientData;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
-	return TCL_ERROR;
-    }
-    return TclVariadicOpCmd(clientData, interp, objc, 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);
 }
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 1d88e11..1ec7c58 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,478 +40,287 @@ 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
  * existence of a procedure call frame to distinguish these.
  */
 
-InstructionDesc const tclInstructionTable[] = {
-    /* Name	      Bytes stackEffect #Opnds  Operand types */
-    {"done",		  1,   -1,         0,	{OPERAND_NONE}},
+InstructionDesc tclInstructionTable[] = {
+   /* Name	      Bytes stackEffect #Opnds Operand types	Stack top, next	  */
+    {"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_LVT1}},
+    
+    {"loadScalar1",	  2,   1,          1,   {OPERAND_UINT1}},
 	/* Load scalar variable at index op1 <= 255 in call frame */
-    {"loadScalar4",	  5,   1,          1,	{OPERAND_LVT4}},
+    {"loadScalar4",	  5,   1,          1,   {OPERAND_UINT4}},
 	/* 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_LVT1}},
+    {"loadArray1",	  2,   0,          1,   {OPERAND_UINT1}},
 	/* Load array element; array at slot op1<=255, element is stktop */
-    {"loadArray4",	  5,   0,          1,	{OPERAND_LVT4}},
+    {"loadArray4",	  5,   0,          1,   {OPERAND_UINT4}},
 	/* 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_LVT1}},
+    {"storeScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
 	/* Store scalar variable at op1<=255 in frame; value is stktop */
-    {"storeScalar4",	  5,   0,          1,	{OPERAND_LVT4}},
+    {"storeScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
 	/* 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_LVT1}},
+    {"storeArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
 	/* Store array element; array at op1<=255, value is top then elem */
-    {"storeArray4",	  5,   -1,         1,	{OPERAND_LVT4}},
+    {"storeArray4",	  5,   -1,          1,   {OPERAND_UINT4}},
 	/* 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_LVT1}},
+    
+    {"incrScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
 	/* 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_LVT1}},
+    {"incrArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
 	/* 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_LVT1, OPERAND_INT1}},
+    {"incrScalar1Imm",	  3,   +1,         2,   {OPERAND_UINT1, 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_LVT1, OPERAND_INT1}},
+    {"incrArray1Imm",	  3,   0,         2,   {OPERAND_UINT1, 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}},
-	/* Greater:	push (stknext > stktop) */
-    {"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}},
+    {"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}},
 	/* 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_AUX4}},
+    {"foreach_start4",	  5,   0,          1,   {OPERAND_UINT4}},
 	/* 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_AUX4}},
+    {"foreach_step4",	  5,   +1,         1,   {OPERAND_UINT4}},
 	/* "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_LVT1}},
+    {"appendScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
 	/* Append scalar variable at op1<=255 in frame; value is stktop */
-    {"appendScalar4",	  5,   0,          1,	{OPERAND_LVT4}},
+    {"appendScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
 	/* Append scalar variable at op1 > 255 in frame; value is stktop */
-    {"appendArray1",	  2,   -1,         1,	{OPERAND_LVT1}},
+    {"appendArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
 	/* Append array element; array at op1<=255, value is top then elem */
-    {"appendArray4",	  5,   -1,         1,	{OPERAND_LVT4}},
+    {"appendArray4",	  5,   -1,         1,   {OPERAND_UINT4}},
 	/* 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_LVT1}},
+    {"lappendScalar1",	  2,   0,          1,   {OPERAND_UINT1}},
 	/* Lappend scalar variable at op1<=255 in frame; value is stktop */
-    {"lappendScalar4",	  5,   0,          1,	{OPERAND_LVT4}},
+    {"lappendScalar4",	  5,   0,          1,   {OPERAND_UINT4}},
 	/* Lappend scalar variable at op1 > 255 in frame; value is stktop */
-    {"lappendArray1",	  2,   -1,         1,	{OPERAND_LVT1}},
+    {"lappendArray1",	  2,   -1,         1,   {OPERAND_UINT1}},
 	/* Lappend array element; array at op1<=255, value is top then elem */
-    {"lappendArray4",	  5,   -1,         1,	{OPERAND_LVT4}},
+    {"lappendArray4",	  5,   -1,         1,   {OPERAND_UINT4}},
 	/* 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.
 	 */
-
-    {"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. The local scalar
-	 * should not refer to a named variable as the value is not wholly
-	 * managed correctly.
-	 * 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. Use unsetScalar
-	 * instead (with 0 for flags). */
-    {"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 (top of the stack, not poppsed) must be the same length as
-	 * the list of variables.
-	 * Stack:  ... keyList => ... 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*/
-
-    {"nop",		 1,    0,         0,	{OPERAND_NONE}},
-	/* Do nothing */
-    {"returnCodeBranch", 1,   -1,	  0,	{OPERAND_NONE}},
-	/* Jump to next instruction based on the return code on top of stack
-	 * ERROR: +1;	RETURN: +3;	BREAK: +5;	CONTINUE: +7;
-	 * Other non-OK: +9
-	 */
-
-    {"unsetScalar",	 6,    0,         2,	{OPERAND_UINT1, OPERAND_LVT4}},
-	/* Make scalar variable at index op2 in call frame cease to exist;
-	 * op1 is 1 for errors on problems, 0 otherwise */
-    {"unsetArray",	 6,    -1,        2,	{OPERAND_UINT1, OPERAND_LVT4}},
-	/* Make array element cease to exist; array at slot op2, element is
-	 * stktop; op1 is 1 for errors on problems, 0 otherwise */
-    {"unsetArrayStk",	 2,    -2,        1,	{OPERAND_UINT1}},
-	/* Make array element cease to exist; element is stktop, array name is
-	 * stknext; op1 is 1 for errors on problems, 0 otherwise */
-    {"unsetStk",	 2,    -1,        1,	{OPERAND_UINT1}},
-	/* Make general variable cease to exist; unparsed variable name is
-	 * stktop; op1 is 1 for errors on problems, 0 otherwise */
-
-    {"dictExpand",       1,    -1,        0,    {OPERAND_NONE}},
-        /* Probe into a dict and extract it (or a subdict of it) into
-         * variables with matched names. Produces list of keys bound as
-         * result. Part of [dict with].
-	 * Stack:  ... dict path => ... keyList */
-    {"dictRecombineStk", 1,    -3,        0,    {OPERAND_NONE}},
-        /* Map variable contents back into a dictionary in a variable. Part of
-         * [dict with].
-	 * Stack:  ... dictVarName path keyList => ... */
-    {"dictRecombineImm", 1,    -2,        1,    {OPERAND_LVT4}},
-        /* Map variable contents back into a dictionary in the local variable
-         * indicated by the LVT index. Part of [dict with].
-	 * Stack:  ... path keyList => ... */
-
-    {NULL, 0, 0, 0, {OPERAND_NONE}}
+    {0, 0, 0, 0, {OPERAND_NONE}}
 };
-
+
 /*
  * Prototypes for procedures defined later in this file:
  */
 
-static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-			    int flags);
-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 void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
-static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
+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));
 #ifdef TCL_COMPILE_STATS
-static void		RecordByteCodeStats(ByteCode *codePtr);
+static void		RecordByteCodeStats _ANSI_ARGS_((
+			    ByteCode *codePtr));
 #endif /* TCL_COMPILE_STATS */
-static int		SetByteCodeFromAny(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
-static int		FormatInstruction(ByteCode *codePtr,
-			    const unsigned char *pc, Tcl_Obj *bufferObj);
-static void		PrintSourceToObj(Tcl_Obj *appendObj,
-			    const char *stringPtr, int maxChars);
-static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
-
-/*
- * 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.
- */
-
-const Tcl_ObjType tclByteCodeType = {
-    "bytecode",			/* name */
-    FreeByteCodeInternalRep,	/* freeIntRepProc */
-    DupByteCodeInternalRep,	/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    SetByteCodeFromAny		/* setFromAnyProc */
-};
-
-/*
- * The structure below defines a bytecode Tcl object type to hold the
- * compiled bytecode for the [subst]itution of Tcl values.
- */
+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 const Tcl_ObjType substCodeType = {
-    "substcode",		/* name */
-    FreeSubstCodeInternalRep,	/* freeIntRepProc */
-    DupByteCodeInternalRep,	/* dupIntRepProc - shared with bytecode */
-    NULL,			/* updateStringProc */
-    NULL,			/* setFromAnyProc */
-};
 
 /*
- * The structure below defines an instruction name Tcl object to allow
- * reporting of inner contexts in errorstack without string allocation.
+ * The structure below defines the bytecode Tcl object type by
+ * means of procedures that can be invoked by generic object code.
  */
 
-static const Tcl_ObjType tclInstNameType = {
-    "instname",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    UpdateStringOfInstName,	/* updateStringProc */
-    NULL,			/* setFromAnyProc */
+Tcl_ObjType tclByteCodeType = {
+    "bytecode",				/* name */
+    FreeByteCodeInternalRep,		/* freeIntRepProc */
+    DupByteCodeInternalRep,		/* dupIntRepProc */
+    (Tcl_UpdateStringProc *) NULL,	/* updateStringProc */
+    SetByteCodeFromAny			/* setFromAnyProc */
 };
 
 /*
@@ -521,10 +330,10 @@ static const Tcl_ObjType tclInstNameType = {
  *
  *	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
@@ -533,52 +342,61 @@ static const Tcl_ObjType tclInstNameType = {
  *
  * 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(
-    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(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. */
 {
     Interp *iPtr = (Interp *) interp;
-    CompileEnv compEnv;		/* Compilation environment structure allocated
-				 * in frame. */
-    register const AuxData *auxDataPtr;
+    CompileEnv compEnv;		/* Compilation environment structure
+				 * allocated in frame. */
+    LiteralTable *localTablePtr = &(compEnv.localLitTable);
+    register AuxData *auxDataPtr;
     LiteralEntry *entryPtr;
     register int i;
-    int length, result = TCL_OK;
-    const char *stringPtr;
-    ContLineLoc *clLocPtr;
-
+    int length, nested, result;
+    char *string;
+#ifdef TCL_TIP280
+    ContLineLoc* clLocPtr;
+#endif
 #ifdef TCL_COMPILE_DEBUG
     if (!traceInitialized) {
-	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;
+        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;
     }
 #endif
 
-    stringPtr = TclGetStringFromObj(objPtr, &length);
-
+    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
     /*
-     * 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.
+     * 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).
      */
 
-    TclInitCompileEnv(interp, &compEnv, stringPtr, length,
-	    iPtr->invokeCmdFramePtr, iPtr->invokeWord);
-
+    TclInitCompileEnv(interp, &compEnv, string, 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.
@@ -586,54 +404,56 @@ TclSetByteCodeFromAny(
      * It is not clear if the script Tcl_Obj* can be free'd while the compiler
      * 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 in the function TclFreeCompileEnv(),
+     * lock on it. We release this lock in the function TclFreeCompileEnv (),
      * found in this file. The "lineCLPtr" hashtable is managed in the file
      * "tclObj.c".
      */
 
-    clLocPtr = TclContinuationsGet(objPtr);
+    clLocPtr = TclContinuationsGet (objPtr);
     if (clLocPtr) {
-	compEnv.clLoc = clLocPtr;
+	compEnv.clLoc  = clLocPtr;
 	compEnv.clNext = &compEnv.clLoc->loc[0];
-	Tcl_Preserve(compEnv.clLoc);
+	Tcl_Preserve (compEnv.clLoc);
     }
+#endif
+    result = TclCompileScript(interp, string, length, nested, &compEnv);
 
-    TclCompileScript(interp, stringPtr, length, &compEnv);
-
-    /*
-     * Successful compilation. Add a "done" instruction at the end.
-     */
-
-    TclEmitOpcode(INST_DONE, &compEnv);
+    if (result == TCL_OK) {
+	/*
+	 * Successful compilation. Add a "done" instruction at the end.
+	 */
 
-    /*
-     * Invoke the compilation hook procedure if one exists.
-     */
+	compEnv.numSrcBytes = iPtr->termOffset;
+	TclEmitOpcode(INST_DONE, &compEnv);
 
-    if (hookProc) {
-	result = hookProc(interp, &compEnv, clientData);
-    }
+	/*
+	 * Invoke the compilation hook procedure if one exists.
+	 */
 
-    /*
-     * Change the object into a ByteCode object. Ownership of the literal
-     * objects and aux data items is given to the ByteCode object.
-     */
+	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.
+	 */
+    
 #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);
-	fflush(stdout);
-    }
+	if (tclTraceCompile >= 2) {
+	    TclPrintByteCodeObj(interp, objPtr);
+	}
 #endif /* TCL_COMPILE_DEBUG */
-
+    }
+	
     if (result != TCL_OK) {
 	/*
-	 * Handle any error from the hookProc
+	 * Compilation errors. 
 	 */
 
 	entryPtr = compEnv.literalArrayPtr;
@@ -654,6 +474,14 @@ TclSetByteCodeFromAny(
 	}
     }
 
+
+    /*
+     * Free storage allocated during compilation.
+     */
+    
+    if (localTablePtr->buckets != localTablePtr->staticBuckets) {
+	ckfree((char *) localTablePtr->buckets);
+    }
     TclFreeCompileEnv(&compEnv);
     return result;
 }
@@ -674,24 +502,24 @@ TclSetByteCodeFromAny(
  *
  * 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(
-    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(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. */
 {
     if (interp == NULL) {
 	return TCL_ERROR;
     }
-    TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
-    return TCL_OK;
+    return TclSetByteCodeFromAny(interp, objPtr,
+	    (CompileHookProc *) NULL, (ClientData) NULL);
 }
 
 /*
@@ -699,8 +527,8 @@ SetByteCodeFromAny(
  *
  * 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.
  *
@@ -714,9 +542,9 @@ SetByteCodeFromAny(
  */
 
 static void
-DupByteCodeInternalRep(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+DupByteCodeInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
 {
     return;
 }
@@ -726,33 +554,35 @@ DupByteCodeInternalRep(
  *
  * 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(
-    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
+FreeByteCodeInternalRep(objPtr)
+    register Tcl_Obj *objPtr;	/* Object whose internal rep to free. */
 {
-    register ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+    register ByteCode *codePtr =
+	    (ByteCode *) objPtr->internalRep.otherValuePtr;
 
-    objPtr->typePtr = NULL;
-    objPtr->internalRep.otherValuePtr = NULL;
     codePtr->refCount--;
     if (codePtr->refCount <= 0) {
 	TclCleanupByteCode(codePtr);
     }
+    objPtr->typePtr = NULL;
+    objPtr->internalRep.otherValuePtr = NULL;
 }
 
 /*
@@ -768,23 +598,25 @@ FreeByteCodeInternalRep(
  *	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
+ *	and objPtr->internalRep.otherValuePtr NULL. Also releases its
+ *	literals and frees its auxiliary data items.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclCleanupByteCode(
-    register ByteCode *codePtr)	/* Points to the ByteCode to free. */
+TclCleanupByteCode(codePtr)
+    register ByteCode *codePtr;	/* Points to the ByteCode to free. */
 {
     Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
-    Interp *iPtr = (Interp *) interp;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
     int numLitObjects = codePtr->numLitObjects;
     int numAuxDataItems = codePtr->numAuxDataItems;
-    register Tcl_Obj **objArrayPtr, *objPtr;
-    register const AuxData *auxDataPtr;
+    register Tcl_Obj **objArrayPtr;
+    register AuxData *auxDataPtr;
     int i;
 #ifdef TCL_COMPILE_STATS
 
@@ -793,19 +625,19 @@ TclCleanupByteCode(
 	Tcl_Time destroyTime;
 	int lifetimeSec, lifetimeMicroSec, log2;
 
-	statsPtr = &iPtr->stats;
+	statsPtr = &((Interp *) interp)->stats;
 
 	statsPtr->numByteCodesFreed++;
 	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);
@@ -813,9 +645,9 @@ TclCleanupByteCode(
 	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;
@@ -825,28 +657,21 @@ TclCleanupByteCode(
 #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, 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.
+     * 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.
      *
-     * 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.
+     * 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.
      */
 
-    if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) || (interp == NULL)) {
-
+    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
+	register Tcl_Obj *objPtr;
+ 
 	objArrayPtr = codePtr->objArrayPtr;
 	for (i = 0;  i < numLitObjects;  i++) {
 	    objPtr = *objArrayPtr;
@@ -856,30 +681,36 @@ TclCleanupByteCode(
 	    objArrayPtr++;
 	}
 	codePtr->numLitObjects = 0;
-    } else {
+    } 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.
+	 */
+	 
 	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.
 	     */
-
-	    objPtr = *objArrayPtr;
-	    if (objPtr != NULL) {
-		TclReleaseLiteral(interp, objPtr);
+	    
+	    if (*objArrayPtr != NULL) {
+		TclReleaseLiteral(interp, *objArrayPtr);
 	    }
 	    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,
@@ -889,207 +720,43 @@ TclCleanupByteCode(
      */
 
     if (iPtr) {
-	Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
-		(char *) codePtr);
-
+	Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
 	if (hePtr) {
-	    ExtCmdLoc *eclPtr = Tcl_GetHashValue(hePtr);
-
-	    if (eclPtr->type == TCL_LOCATION_SOURCE) {
-		Tcl_DecrRefCount(eclPtr->path);
-	    }
-	    for (i=0 ; i<eclPtr->nuloc ; i++) {
-		ckfree(eclPtr->loc[i].line);
-	    }
-
-	    if (eclPtr->loc != NULL) {
-		ckfree(eclPtr->loc);
-	    }
-
-	    Tcl_DeleteHashTable(&eclPtr->litInfo);
+	    ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
 
-	    ckfree(eclPtr);
-	    Tcl_DeleteHashEntry(hePtr);
+	    ReleaseCmdWordData (eclPtr);
+	    Tcl_DeleteHashEntry (hePtr);
 	}
     }
-
-    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
-	TclFreeLocalCache(interp, codePtr->localCachePtr);
-    }
+#endif
 
     TclHandleRelease(codePtr->interpHandle);
-    ckfree(codePtr);
+    ckfree((char *) codePtr);
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * 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. */
+#ifdef TCL_TIP280
+static void
+ReleaseCmdWordData (eclPtr)
+     ExtCmdLoc* eclPtr;
 {
-    NRE_callback *rootPtr = TOP_CB(interp);
+    int        i;
 
-    if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags),
-	    rootPtr) != TCL_OK) {
-	return NULL;
+    if (eclPtr->type == TCL_LOCATION_SOURCE) {
+	Tcl_DecrRefCount (eclPtr->path);
     }
-    return Tcl_GetObjResult(interp);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NRSubstObj --
- *
- *	Request substitution of a Tcl value by the NR stack.
- *
- * Results:
- *	Returns TCL_OK.
- *
- * Side effects:
- *	Compiles objPtr into bytecode that performs the substitutions as
- *	governed by flags and places callbacks on the NR stack to execute
- *	the bytecode and store the result in the interp.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_NRSubstObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    int flags)
-{
-    ByteCode *codePtr = CompileSubstObj(interp, objPtr, flags);
-
-    /* TODO: Confirm we do not need this. */
-    /* Tcl_ResetResult(interp); */
-    return TclNRExecuteByteCode(interp, codePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileSubstObj --
- *
- *	Compile a Tcl value into ByteCode implementing its substitution, as
- *	governed by flags.
- *
- * Results:
- *	A (ByteCode *) is returned pointing to the resulting ByteCode.
- *	The caller must manage its refCount and arrange for a call to
- *	TclCleanupByteCode() when the last reference disappears.
- *
- * Side effects:
- *	The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
- *	ByteCode and governing flags value are kept in the internal rep for
- *	faster operations the next time CompileSubstObj is called on the same
- *	value.
- *
- *----------------------------------------------------------------------
- */
-
-static ByteCode *
-CompileSubstObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    int flags)
-{
-    Interp *iPtr = (Interp *) interp;
-    ByteCode *codePtr = NULL;
-
-    if (objPtr->typePtr == &substCodeType) {
-	Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
-
-	codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
-	if ((unsigned long)flags != objPtr->internalRep.ptrAndLongRep.value
-		|| ((Interp *) *codePtr->interpHandle != iPtr)
-		|| (codePtr->compileEpoch != iPtr->compileEpoch)
-		|| (codePtr->nsPtr != nsPtr)
-		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
-		|| (codePtr->localCachePtr !=
-		iPtr->varFramePtr->localCachePtr)) {
-	    FreeSubstCodeInternalRep(objPtr);
-	}
+    for (i=0; i < eclPtr->nuloc; i++) {
+	ckfree ((char*) eclPtr->loc[i].line);
     }
-    if (objPtr->typePtr != &substCodeType) {
-	CompileEnv compEnv;
-	int numBytes;
-	const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
 
-	/* TODO: Check for more TIP 280 */
-	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);
-
-	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);
-
-	TclEmitOpcode(INST_DONE, &compEnv);
-	TclInitByteCodeObj(objPtr, &compEnv);
-	objPtr->typePtr = &substCodeType;
-	TclFreeCompileEnv(&compEnv);
-
-	codePtr = objPtr->internalRep.otherValuePtr;
-	objPtr->internalRep.ptrAndLongRep.ptr = codePtr;
-	objPtr->internalRep.ptrAndLongRep.value = flags;
-	if (iPtr->varFramePtr->localCachePtr) {
-	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
-	    codePtr->localCachePtr->refCount++;
-	}
-	/* TODO: Debug printing? */
+    if (eclPtr->loc != NULL) {
+	ckfree ((char*) eclPtr->loc);
     }
-    return codePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeSubstCodeInternalRep --
- *
- *	Part of the substcode Tcl object type implementation. Frees the
- *	storage associated with a substcode object's internal representation
- *	unless its code is actively being executed.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The substcode 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
-FreeSubstCodeInternalRep(
-    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
-{
-    register ByteCode *codePtr = objPtr->internalRep.ptrAndLongRep.ptr;
+    Tcl_DeleteHashTable (&eclPtr->litInfo);
 
-    objPtr->typePtr = NULL;
-    objPtr->internalRep.otherValuePtr = NULL;
-    codePtr->refCount--;
-    if (codePtr->refCount <= 0) {
-	TclCleanupByteCode(codePtr);
-    }
+    ckfree ((char*) eclPtr);
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -1109,21 +776,27 @@ FreeSubstCodeInternalRep(
  */
 
 void
-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 */
+#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
 {
     Interp *iPtr = (Interp *) interp;
-
+    
     envPtr->iPtr = iPtr;
-    envPtr->source = stringPtr;
+    envPtr->source = string;
     envPtr->numSrcBytes = numBytes;
     envPtr->procPtr = iPtr->compiledProcPtr;
     iPtr->compiledProcPtr = NULL;
@@ -1132,28 +805,28 @@ TclInitCompileEnv(
     envPtr->maxExceptDepth = 0;
     envPtr->maxStackDepth = 0;
     envPtr->currStackDepth = 0;
-    TclInitLiteralTable(&envPtr->localLitTable);
+    TclInitLiteralTable(&(envPtr->localLitTable));
 
     envPtr->codeStart = envPtr->staticCodeSpace;
     envPtr->codeNext = envPtr->codeStart;
-    envPtr->codeEnd = envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES;
+    envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
     envPtr->mallocedCodeArray = 0;
 
     envPtr->literalArrayPtr = envPtr->staticLiteralSpace;
     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
@@ -1163,129 +836,84 @@ TclInitCompileEnv(
      * non-compiling evaluator
      */
 
-    envPtr->extCmdMapPtr = 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) || (invoker->type == TCL_LOCATION_EVAL_LIST)) {
-	/*
+    if (invoker == NULL ||
+	(invoker->type == TCL_LOCATION_EVAL_LIST)) {
+        /*
 	 * Initialize the compiler for relative counting in case of a
 	 * dynamic context.
 	 */
 
-	envPtr->line = 1;
-	if (iPtr->evalFlags & TCL_EVAL_FILE) {
-	    iPtr->evalFlags &= ~TCL_EVAL_FILE;
-	    envPtr->extCmdMapPtr->type = TCL_LOCATION_SOURCE;
-
-	    if (iPtr->scriptFile) {
-		/*
-		 * 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.
-		 */
-
-		Tcl_Obj *norm =
-			Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);
-
-		if (norm == NULL) {
-		    /*
-		     * Error message in the interp result. No place to put it.
-		     * And no place to serve the error itself to either. Fake
-		     * a path, empty string.
-		     */
-
-		    TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
-		} else {
-		    envPtr->extCmdMapPtr->path = norm;
-		}
-	    } else {
-		TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
-	    }
-
-	    Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
-	} else {
-	    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 *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-	int pc = 0;
+	CmdFrame ctx = *invoker;
+	int      pc  = 0;
 
-	*ctxPtr = *invoker;
 	if (invoker->type == TCL_LOCATION_BC) {
-	    /*
-	     * Note: Type BC => ctx.data.eval.path    is not used.
-	     *			ctx.data.tebc.codePtr is used instead.
-	     */
-
-	    TclGetSrcInfoForPc(ctxPtr);
+	    /* Note: Type BC => ctx.data.eval.path    is not used.
+	     *                  ctx.data.tebc.codePtr is used instead.
+		 */
+	    TclGetSrcInfoForPc (&ctx);
 	    pc = 1;
 	}
 
-	if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) {
-	    /*
-	     * Word is not a literal, relative counting.
-	     */
+	if ((ctx.nline <= word) || (ctx.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 && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
+	    if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
 		/*
 		 * The reference made by 'TclGetSrcInfoForPc' is dead.
 		 */
-
-		Tcl_DecrRefCount(ctxPtr->data.eval.path);
+		Tcl_DecrRefCount(ctx.data.eval.path);
 	    }
 	} else {
-	    envPtr->line = ctxPtr->line[word];
-	    envPtr->extCmdMapPtr->type = ctxPtr->type;
-
-	    if (ctxPtr->type == TCL_LOCATION_SOURCE) {
-		envPtr->extCmdMapPtr->path = ctxPtr->data.eval.path;
+	    envPtr->line               = ctx.line [word];
+	    envPtr->extCmdMapPtr->type = ctx.type;
+	    envPtr->extCmdMapPtr->path = ctx.data.eval.path;
 
+	    if (ctx.type == TCL_LOCATION_SOURCE) {
 		if (pc) {
-		    /*
-		     * The reference 'TclGetSrcInfoForPc' made is transfered.
-		     */
-
-		    ctxPtr->data.eval.path = NULL;
+		    /* The reference 'TclGetSrcInfoForPc' made is transfered */
+		    ctx.data.eval.path = NULL;
 		} else {
-		    /*
-		     * We have a new reference here.
-		     */
-
-		    Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
+		    /* We have a new reference here */
+		    Tcl_IncrRefCount (ctx.data.eval.path);
 		}
 	    }
 	}
 
-	TclStackFree(interp, ctxPtr);
+	/* ctx going out of scope */
     }
 
-    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 such
-     * data is available.
+     * Initialize the data about invisible continuation lines as empty,
+     * i.e. not used. The caller (TclSetByteCodeFromAny) will set this up, if
+     * such data is available.
      */
 
-    envPtr->clLoc = NULL;
+    envPtr->clLoc  = NULL;
     envPtr->clNext = NULL;
+#endif
 
     envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
     envPtr->auxDataArrayNext = 0;
@@ -1303,45 +931,38 @@ TclInitCompileEnv(
  *
  * 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(
-    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
+TclFreeCompileEnv(envPtr)
+    register CompileEnv *envPtr; /* Points to the CompileEnv structure. */
 {
-    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
-	ckfree(envPtr->localLitTable.buckets);
-	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
-    }
     if (envPtr->mallocedCodeArray) {
-	ckfree(envPtr->codeStart);
+	ckfree((char *) envPtr->codeStart);
     }
     if (envPtr->mallocedLiteralArray) {
-	ckfree(envPtr->literalArrayPtr);
+	ckfree((char *) envPtr->literalArrayPtr);
     }
     if (envPtr->mallocedExceptArray) {
-	ckfree(envPtr->exceptArrayPtr);
+	ckfree((char *) envPtr->exceptArrayPtr);
     }
     if (envPtr->mallocedCmdMap) {
-	ckfree(envPtr->cmdMapPtr);
+	ckfree((char *) envPtr->cmdMapPtr);
     }
     if (envPtr->mallocedAuxDataArray) {
-	ckfree(envPtr->auxDataArrayPtr);
+	ckfree((char *) envPtr->auxDataArrayPtr);
     }
-    if (envPtr->extCmdMapPtr) {
-	ckfree(envPtr->extCmdMapPtr);
-    }
-
+#ifdef TCL_TIP280
     /*
      * 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
@@ -1349,10 +970,15 @@ TclFreeCompileEnv(
      */
 
     if (envPtr->clLoc) {
-	Tcl_Release(envPtr->clLoc);
+	Tcl_Release (envPtr->clLoc);
     }
+    if (envPtr->extCmdMapPtr) {
+	ReleaseCmdWordData (envPtr->extCmdMapPtr);
+    }
+#endif
 }
 
+#ifdef TCL_TIP280
 /*
  *----------------------------------------------------------------------
  *
@@ -1370,68 +996,35 @@ TclFreeCompileEnv(
  *	it is worthwhile to compile at all.
  *
  * Side effects:
- *	When returning true, appends the known value of the word to the
- *	unshared Tcl_Obj (*valuePtr), unless valuePtr is NULL.
+ *	None.
  *
+ * TIP #280
  *----------------------------------------------------------------------
  */
 
 int
-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. */
+TclWordKnownAtCompileTime (tokenPtr)
+     Tcl_Token* tokenPtr;
 {
-    int numComponents = tokenPtr->numComponents;
-    Tcl_Obj *tempPtr = NULL;
-
-    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;
+    int        i;
+    Tcl_Token* sub;
 
-	case TCL_TOKEN_BS:
-	    if (tempPtr != NULL) {
-		char utfBuf[TCL_UTF_MAX];
-		int length = TclParseBackslash(tokenPtr->start,
-			tokenPtr->size, NULL, utfBuf);
+    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {return 1;};
+    if (tokenPtr->type != TCL_TOKEN_WORD)        {return 0;};
 
-		Tcl_AppendToObj(tempPtr, utfBuf, length);
-	    }
-	    break;
+    /* Check the sub tokens of the word. It is a literal if we find
+     * only BS and TEXT tokens */
 
-	default:
-	    if (tempPtr != NULL) {
-		Tcl_DecrRefCount(tempPtr);
-	    }
-	    return 0;
-	}
-	tokenPtr++;
-    }
-    if (valuePtr != NULL) {
-	Tcl_AppendObjToObj(valuePtr, tempPtr);
-	Tcl_DecrRefCount(tempPtr);
+    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;
     }
     return 1;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -1445,41 +1038,55 @@ TclWordKnownAtCompileTime(
  *	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.
  *
  *----------------------------------------------------------------------
  */
 
-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
+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
 				 * script consists of all bytes up to the
 				 * first null character. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
+    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. */
 {
     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. */
+    				/* Index of most recent toplevel command in
+ 				 * 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, wordIdx, currCmdIndex, commandLength, objIndex;
+    int bytesLeft, isFirstCmd, gotParse, wordIdx, currCmdIndex;
+    int commandLength, objIndex, code;
     Tcl_DString ds;
+
+#ifdef TCL_TIP280
     /* TIP #280 */
-    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
-    int *wlines, wlineat, cmdLine, *clNext;
-    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
+    ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
+    int* wlines = NULL;
+    int  wlineat, cmdLine;
+    int* clNext;
+#endif
 
     Tcl_DStringInit(&ds);
 
@@ -1489,52 +1096,70 @@ TclCompileScript(
     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;
+    clNext  = envPtr->clNext;
+#endif
+
     do {
-	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
+	if (Tcl_ParseCommand(interp, p, bytesLeft, nested, &parse) != TCL_OK) {
+	    code = TCL_ERROR;
+	    goto error;
+	}
+	gotParse = 1;
+	if (nested) {
 	    /*
-	     * Compile bytecodes to report the parse error at runtime.
+	     * 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...
 	     */
 
-	    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;
-	}
-
-	/*
-	 * TIP #280: We have to count newlines before the command even in the
-	 * degenerate case when the command has no words. (See test
-	 * info-30.33).
-	 * So make that counting here, and not in the (numWords > 0) branch
-	 * below.
-	 */
-
-	TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
-	TclAdvanceContinuations(&cmdLine, &clNext,
-		parsePtr->commandStart - envPtr->source);
-
-	if (parsePtr->numWords > 0) {
-	    int expand = 0;	/* Set if there are dynamic expansions to
-				 * handle */
+	    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;
+	    }
+	}
+	if (parse.numWords > 0) {
 	    /*
 	     * If not the first command, pop the previous command's result
 	     * and, if we're compiling a top level command, update the last
@@ -1543,295 +1168,204 @@ TclCompileScript(
 
 	    if (!isFirstCmd) {
 		TclEmitOpcode(INST_POP, envPtr);
-		envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
-			(envPtr->codeNext - envPtr->codeStart)
-			- startCodeOffset;
+		if (!nested) {
+		    envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
+			   (envPtr->codeNext - envPtr->codeStart)
+			   - startCodeOffset;
+		}
 	    }
 
 	    /*
 	     * Determine the actual length of the command.
 	     */
 
-	    commandLength = parsePtr->commandSize;
-	    if (parsePtr->term == parsePtr->commandStart + commandLength-1) {
+	    commandLength = parse.commandSize;
+	    if (parse.term == parse.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) && (envPtr->procPtr == NULL)) {
+	    if ((tclTraceCompile >= 1)
+		    && !nested && (envPtr->procPtr == NULL)) {
 		fprintf(stdout, "  Compiling: ");
-		TclPrintSource(stdout, parsePtr->commandStart,
+		TclPrintSource(stdout, parse.commandStart,
 			TclMin(commandLength, 55));
 		fprintf(stdout, "\n");
 	    }
 #endif
-
 	    /*
-	     * Check whether expansion has been requested for any of the
-	     * words.
+	     * 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) {
-		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
-		    expand = 1;
-		    break;
-		}
-	    }
-
+	    
 	    envPtr->numCommands++;
-	    currCmdIndex = envPtr->numCommands - 1;
-	    lastTopLevelCmdIndex = currCmdIndex;
-	    startCodeOffset = envPtr->codeNext - envPtr->codeStart;
-	    EnterCmdStartData(envPtr, currCmdIndex,
-		    parsePtr->commandStart - envPtr->source, startCodeOffset);
-
-	    /*
-	     * 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);
+	    currCmdIndex = (envPtr->numCommands - 1);
+	    if (!nested) {
+		lastTopLevelCmdIndex = currCmdIndex;
 	    }
+	    startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
+	    EnterCmdStartData(envPtr, currCmdIndex,
+	            (parse.commandStart - envPtr->source), startCodeOffset);
 
-	    /*
-	     * TIP #280. Scan the words and compute the extended location
+#ifdef TCL_TIP280
+	    /* 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'.
 	     */
 
-	    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
-		    parsePtr->tokenPtr, parsePtr->commandStart,
-		    parsePtr->commandSize, parsePtr->numWords, cmdLine,
-		    clNext, &wlines, envPtr);
+	    TclAdvanceLines         (&cmdLine, p, parse.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);
 	    wlineat = eclPtr->nuloc - 1;
+#endif
 
-	    /*
-	     * 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];
-		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-		    /*
-		     * The word is not a simple string of characters.
-		     */
-
-		    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) {
+	    for (wordIdx = 0, tokenPtr = parse.tokenPtr;
+		    wordIdx < parse.numWords;
+		    wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
+#ifdef TCL_TIP280
+	        envPtr->line   = eclPtr->loc [wlineat].line [wordIdx];
+		envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx];
+#endif
+		if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 		    /*
-		     * 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.
+		     * If this is the first word and the command has a
+		     * compile procedure, let it compile the 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->nsPtr->flags&NS_SUPPRESS_COMPILATION)
-			    && !(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;
+		    if (wordIdx == 0) {
+			if (envPtr->procPtr != NULL) {
+			    cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
+			} else {
+			    cmdNsPtr = NULL; /* use current NS */
+			}
 
 			/*
-			 * 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
-			 * TclNRExecuteByteCode(). 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.
+			 * 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.
 			 */
 
-			if (envPtr->atCmdStart) {
-			    if (savedCodeNext != 0) {
+			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) {
 				/*
-				 * 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!
+				 * Restore numCommands and codeNext to their correct 
+				 * values, removing any commands compiled before 
+				 * TCL_OUT_LINE_COMPILE [Bugs 705406 and 735055]
 				 */
-
-				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) {
+				envPtr->numCommands = savedNumCmds;
+				envPtr->codeNext = envPtr->codeStart + savedCodeNext;
+			    } else { /* an error */
 				/*
-				 * Fix the bytecode length.
+				 * There was a compilation error, the last
+				 * command did not get compiled into (*envPtr).
+				 * Decrement the number of commands
+				 * claimed to be in (*envPtr).
 				 */
-
-				unsigned char *fixPtr = envPtr->codeStart
-					+ savedCodeNext + 1;
-				unsigned fixLen = envPtr->codeNext
-					- envPtr->codeStart - savedCodeNext;
-
-				TclStoreInt4AtPtr(fixLen, fixPtr);
+				envPtr->numCommands--;
+				goto log;
 			    }
-			    goto finishCommand;
-			}
-
-			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!
-			     */
-
-			    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]
+			 * No compile procedure so push the word. If the
+			 * command was found, push a CmdName object to
+			 * reduce runtime lookups.
 			 */
 
-			envPtr->numCommands = savedNumCmds;
-			envPtr->codeNext = envPtr->codeStart + savedCodeNext;
-		    }
-
-		    /*
-		     * No compile procedure so push the word. If the command
-		     * was found, push a CmdName object to reduce runtime
-		     * lookups. Mark this as a command name literal to reduce
-		     * shimmering. 
-		     */
+			objIndex = TclRegisterNewLiteral(envPtr,
+				tokenPtr[1].start, tokenPtr[1].size);
+			if (cmdPtr != NULL) {
+			    TclSetCmdNameObj(interp,
+			           envPtr->literalArrayPtr[objIndex].objPtr,
+				   cmdPtr);
+			}
+		    } 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.
+			 */
 
-		    objIndex = TclRegisterNewCmdLiteral(envPtr,
-			    tokenPtr[1].start, tokenPtr[1].size);
-		    if (cmdPtr != NULL) {
-			TclSetCmdNameObj(interp,
-				envPtr->literalArrayPtr[objIndex].objPtr,
-				cmdPtr);
+			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
 		    }
+		    TclEmitPush(objIndex, envPtr);
 		} 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.
+		     * The word is not a simple string of characters.
 		     */
-
-		    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]);
+		    code = TclCompileTokens(interp, tokenPtr+1,
+			    tokenPtr->numComponents, envPtr);
+		    if (code != TCL_OK) {
+			goto log;
 		    }
 		}
-		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 (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) {
+	    
+	    if (wordIdx > 0) {
+#ifdef TCL_TIP280
 		/*
 		 * Save PC -> command map for the TclArgumentBC* functions.
 		 */
 
 		int isnew;
-		Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
-			INT2PTR(envPtr->codeNext - envPtr->codeStart),
-			&isnew);
-
-		Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
+		Tcl_HashEntry* hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
+			   (char*) (envPtr->codeNext - envPtr->codeStart), &isnew);
+		Tcl_SetHashValue(hePtr, (char*) wlineat);
+#endif
 		if (wordIdx <= 255) {
 		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
 		} else {
@@ -1844,59 +1378,115 @@ TclCompileScript(
 	     * offsets of the source and code for the command.
 	     */
 
-	finishCommand:
+	    finishCommand:
 	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
 		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
 	    isFirstCmd = 0;
 
-	    /*
-	     * TIP #280: Free full form of per-word line data and insert the
-	     * reduced form now
+#ifdef TCL_TIP280
+	    /* TIP #280: Free full form of per-word line data and insert
+	     * the reduced form now
 	     */
-
-	    ckfree(eclPtr->loc[wlineat].line);
-	    ckfree(eclPtr->loc[wlineat].next);
-	    eclPtr->loc[wlineat].line = wlines;
-	    eclPtr->loc[wlineat].next = NULL;
-	} /* end if parsePtr->numWords > 0 */
+	    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 */
 
 	/*
 	 * Advance to the next command in the script.
 	 */
 
-	next = parsePtr->commandStart + parsePtr->commandSize;
-	bytesLeft -= next - p;
+	next = parse.commandStart + parse.commandSize;
+	bytesLeft -= (next - p);
 	p = next;
+#ifdef TCL_TIP280
+	/* TIP #280 : Track lines in the just compiled command */
+	TclAdvanceLines         (&cmdLine, parse.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;
+	}
+    } 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) {
 	/*
-	 * TIP #280: Track lines in the just compiled command.
+	 * When (nested != 0) back up 1 character to have 
+	 * iPtr->termOffset indicate the offset to the matching
+	 * close-bracket.
 	 */
 
-	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
-	TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
-	Tcl_FreeParse(parsePtr);
-    } while (bytesLeft > 0);
-
+	iPtr->termOffset = (p - 1) - script;
+    } else {
+	iPtr->termOffset = (p - script);
+    }
+    Tcl_DStringFree(&ds);
+    return TCL_OK;
+	
+    error:
     /*
-     * TIP #280: Bring the line counts in the CompEnv up to date.
-     *	See tests info-30.33,34,35 .
+     * 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.
      */
 
-    envPtr->line = cmdLine;
-    envPtr->clNext = clNext;
+    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.
+	 */
 
-    /*
-     * If the source script yielded no instructions (e.g., if it was empty),
-     * push an empty string as the command's result.
-     */
+	commandLength -= 1;
+    }
 
-    if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+ 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;
     }
+#endif
 
-    envPtr->numSrcBytes = p - script;
-    TclStackFree(interp, parsePtr);
+    LogCompilationInfo(interp, script, parse.commandStart, commandLength);
+    if (gotParse) {
+	Tcl_FreeParse(&parse);
+    }
+    iPtr->termOffset = (p - script);
     Tcl_DStringFree(&ds);
+    return code;
 }
 
 /*
@@ -1905,238 +1495,253 @@ TclCompileScript(
  * 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.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TclCompileVarSubst(
-    Tcl_Interp *interp,
-    Tcl_Token *tokenPtr,
-    CompileEnv *envPtr)
-{
-    const char *p, *name = tokenPtr[1].start;
-    int nameBytes = tokenPtr[1].size;
-    int i, localVar, localVarName = 1;
-
-    /*
-     * 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).
-     */
-
-    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.
-     */
-
-    localVar = -1;
-    if (localVarName != -1) {
-	localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
-    }
-    if (localVar < 0) {
-	TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes), envPtr);
-    }
-
-    /*
-     * Emit instructions to load the variable.
-     */
-
-    TclAdvanceLines(&envPtr->line, tokenPtr[1].start,
-	    tokenPtr[1].start + tokenPtr[1].size);
-
-    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 {
-	    TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
-	}
-    }
-}
-
-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.
+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.
 				 * 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];
-    int i, numObjsToConcat, length;
+    CONST char *name, *p;
+    int numObjsToConcat, nameBytes, localVarName, localVar;
+    int length, i, code;
     unsigned char *entryCodeNext = envPtr->codeNext;
+#ifdef TCL_TIP280
 #define NUM_STATIC_POS 20
     int isLiteral, maxNumCL, numCL;
-    int *clPosition = NULL;
+    int* clPosition = NULL;
 
     /*
      * 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.
+     * locations of all continuation lines we find in this literal, if
+     * any. The table is extended if needed.
      *
-     * Note: Different to the equivalent code in function '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 these two possibilities yet.
-     * It might be a difference between compile- versus run-time processing.
+     * Note: Different to the equivalent code in function
+     * 'EvalTokensStandard()' (see file "tclBasic.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
+     * these two possibilities yet. It might be a difference between compile-
+     * versus runtime processing.
      */
 
-    numCL = 0;
-    maxNumCL = 0;
+    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)) {
+	if ((tokenPtr[i].type != TCL_TOKEN_TEXT) &&
+	    (tokenPtr[i].type != TCL_TOKEN_BS)) {
 	    isLiteral = 0;
 	    break;
 	}
     }
 
     if (isLiteral) {
-	maxNumCL = NUM_STATIC_POS;
-	clPosition = ckalloc(maxNumCL * sizeof(int));
+	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);
-	    TclAdvanceLines(&envPtr->line, tokenPtr->start,
-		    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,
-		    NULL, buffer);
-	    Tcl_DStringAppend(&textBuffer, buffer, length);
+	    case TCL_TOKEN_BS:
+		length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
+			(int *) NULL, buffer);
+		Tcl_DStringAppend(&textBuffer, buffer, length);
 
-	    /*
-	     * 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.
-	     */
+#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 = 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 = ckrealloc(clPosition,
-                                maxNumCL * sizeof(int));
+			if (numCL >= maxNumCL) {
+			    maxNumCL *= 2;
+			    clPosition = (int*) ckrealloc ((char*)clPosition,
+							   maxNumCL*sizeof(int));
+			}
+			clPosition[numCL] = clPos;
+			numCL ++;
 		    }
-		    clPosition[numCL] = clPos;
-		    numCL ++;
 		}
-	    }
-	    break;
-
-	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));
+#endif
+		break;
 
-		TclEmitPush(literal, envPtr);
+	    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;
+		}
 		numObjsToConcat++;
-		Tcl_DStringFree(&textBuffer);
+		break;
 
-		if (numCL) {
-		    TclContinuationsEnter(
-			    envPtr->literalArrayPtr[literal].objPtr, numCL,
-			    clPosition);
+	    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);
+		}
+		
+		/*
+		 * 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>.
-	     */
+		/*
+		 * Either push the variable's name, or find its index in
+		 * the array of local variables in a procedure frame. 
+		 */
 
-	    if (Tcl_DStringLength(&textBuffer) > 0) {
-		int literal;
+		localVar = -1;
+		if (localVarName != -1) {
+		    localVar = TclFindCompiledLocal(name, nameBytes, 
+			        localVarName, /*flags*/ 0, envPtr->procPtr);
+		}
+		if (localVar < 0) {
+		    TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
+			    envPtr); 
+		}
 
-		literal = TclRegisterNewLiteral(envPtr,
-			Tcl_DStringValue(&textBuffer),
-			Tcl_DStringLength(&textBuffer));
-		TclEmitPush(literal, 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 {
+		    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);
+		    }
+		}
 		numObjsToConcat++;
-		Tcl_DStringFree(&textBuffer);
-	    }
-
-	    TclCompileVarSubst(interp, tokenPtr, envPtr);
-	    numObjsToConcat++;
-	    count -= tokenPtr->numComponents;
-	    tokenPtr += tokenPtr->numComponents;
-	    break;
+		count -= tokenPtr->numComponents;
+		tokenPtr += tokenPtr->numComponents;
+		break;
 
-	default:
-	    Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
-		    tokenPtr->type, tokenPtr->size, tokenPtr->start);
+	    default:
+		panic("Unexpected token type in TclCompileTokens");
 	}
     }
 
@@ -2147,16 +1752,18 @@ TclCompileTokens(
     if (Tcl_DStringLength(&textBuffer) > 0) {
 	int literal;
 
-	literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
-		Tcl_DStringLength(&textBuffer));
+	literal = TclRegisterLiteral(envPtr, Tcl_DStringValue(&textBuffer),
+	        Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
 	TclEmitPush(literal, envPtr);
 	numObjsToConcat++;
 
+#ifdef TCL_TIP280
 	if (numCL) {
 	    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
-		    numCL, clPosition);
+				  numCL, clPosition);
 	}
 	numCL = 0;
+#endif
     }
 
     /*
@@ -2174,20 +1781,26 @@ TclCompileTokens(
     /*
      * If the tokens yielded no instructions, push an empty string.
      */
-
+    
     if (envPtr->codeNext == entryCodeNext) {
-	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
+	TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
+	        envPtr);
     }
-    Tcl_DStringFree(&textBuffer);
+    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.
+     * Release the temp table we used to collect the locations of
+     * continuation lines, if any.
      */
 
     if (maxNumCL) {
-	ckfree(clPosition);
+	ckfree ((char*) clPosition);
     }
+#endif
+    return code;
 }
 
 /*
@@ -2198,45 +1811,53 @@ TclCompileTokens(
  *	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.
  *
  *----------------------------------------------------------------------
  */
 
-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.
+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.
 				 * 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)) {
-	/*
-	 * Handle the common case: if there is a single text token, compile it
-	 * into an inline sequence of instructions.
-	 */
+	code = TclCompileScript(interp, tokenPtr->start, tokenPtr->size,
+	        /*nested*/ 0, envPtr);
+	return code;
+    }
 
-	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.
-	 */
+    /*
+     * 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.
+     */
 
-	TclCompileTokens(interp, tokenPtr, count, envPtr);
-	TclEmitOpcode(INST_EVAL_STK, envPtr);
+    code = TclCompileTokens(interp, tokenPtr, count, envPtr);
+    if (code != TCL_OK) {
+	return code;
     }
+    TclEmitOpcode(INST_EVAL_STK, envPtr);
+    return TCL_OK;
 }
 
 /*
@@ -2253,37 +1874,42 @@ TclCompileCmdWord(
  * 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.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
+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. */
 {
     Tcl_Token *wordPtr;
-    int i, concatItems;
+    int numBytes, i, code;
+    CONST char *script;
+
+    code = TCL_OK;
 
     /*
-     * 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)) {
-	TclCompileExpr(interp, tokenPtr[1].start,tokenPtr[1].size, envPtr, 1);
-	return;
+	script = tokenPtr[1].start;
+	numBytes = tokenPtr[1].size;
+	code = TclCompileExpr(interp, script, numBytes, envPtr);
+	return code;
     }
-
+   
     /*
      * Emit code to call the expr command proc at runtime. Concatenate the
      * (already substituted once) expr tokens with a space between each.
@@ -2291,68 +1917,30 @@ TclCompileExprWords(
 
     wordPtr = tokenPtr;
     for (i = 0;  i < numWords;  i++) {
-	TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
+	code = TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents,
+                envPtr);
+	if (code != TCL_OK) {
+	    break;
+	}
 	if (i < (numWords - 1)) {
-	    TclEmitPush(TclRegisterNewLiteral(envPtr, " ", 1), envPtr);
+	    TclEmitPush(TclRegisterLiteral(envPtr, " ", 1, /*onHeap*/ 0),
+	            envPtr);
 	}
-	wordPtr += wordPtr->numComponents + 1;
-    }
-    concatItems = 2*numWords - 1;
-    while (concatItems > 255) {
-	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
-	concatItems -= 254;
-    }
-    if (concatItems > 1) {
-	TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
+	wordPtr += (wordPtr->numComponents + 1);
     }
-    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;
-
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
-		    envPtr);
-	    TclEmitOpcode(INST_POP, envPtr);
+    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);
     }
-    envPtr->currStackDepth = savedStackDepth;
-    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
-    return TCL_OK;
+
+    return code;
 }
 
 /*
@@ -2361,10 +1949,10 @@ TclCompileNoOp(
  * 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
@@ -2372,21 +1960,21 @@ TclCompileNoOp(
  *
  * 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(
-    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(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. */
 {
     register ByteCode *codePtr;
     size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
@@ -2397,46 +1985,45 @@ TclInitByteCodeObj(
 #endif
     int numLitObjects = envPtr->literalArrayNext;
     Namespace *namespacePtr;
-    int i, isNew;
+    int i;
+#ifdef TCL_TIP280
+    int new;
+#endif
     Interp *iPtr;
 
     iPtr = envPtr->iPtr;
 
-    codeBytes = envPtr->codeNext - envPtr->codeStart;
-    objArrayBytes = envPtr->literalArrayNext * sizeof(Tcl_Obj *);
-    exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange);
-    auxDataArrayBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
+    codeBytes = (envPtr->codeNext - envPtr->codeStart);
+    objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
+    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 = ckalloc(structureSize);
+    
+    p = (unsigned char *) ckalloc((size_t) structureSize);
     codePtr = (ByteCode *) p;
     codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
     codePtr->compileEpoch = iPtr->compileEpoch;
     codePtr->nsPtr = namespacePtr;
     codePtr->nsEpoch = namespacePtr->resolverEpoch;
     codePtr->refCount = 1;
-    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
-	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
-    } else {
-	codePtr->flags = 0;
-    }
+    codePtr->flags = 0;
     codePtr->source = envPtr->source;
     codePtr->procPtr = envPtr->procPtr;
 
@@ -2452,46 +2039,28 @@ TclInitByteCodeObj(
 
     p += sizeof(ByteCode);
     codePtr->codeStart = p;
-    memcpy(p, envPtr->codeStart, (size_t) codeBytes);
-
-    p += TCL_ALIGN(codeBytes);		/* align object array */
+    memcpy((VOID *) p, (VOID *) envPtr->codeStart, (size_t) codeBytes);
+    
+    p += TCL_ALIGN(codeBytes);	      /* align object array */
     codePtr->objArrayPtr = (Tcl_Obj **) p;
     for (i = 0;  i < numLitObjects;  i++) {
-	if (objPtr == envPtr->literalArrayPtr[i].objPtr) {
-	    /*
-	     * Prevent circular reference where the bytecode intrep of
-	     * a value contains a literal which is that same value.
-	     * If this is allowed to happen, refcount decrements may not
-	     * reach zero, and memory may leak.  Bugs 467523, 3357771
-	     *
-	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
-	     * on the string value, and do not call Tcl_DuplicateObj() so we
-             * can be sure we do not have any lingering cycles hiding in
-	     * the intrep.
-	     */
-	    int numBytes;
-	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
-
-	    codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
-	    Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
-	    Tcl_DecrRefCount(objPtr);
-	} else {
-	    codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
-	}
+	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(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
+	memcpy((VOID *) p, (VOID *) 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(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
+	memcpy((VOID *) p, (VOID *) envPtr->auxDataArrayPtr,
+	        (size_t) auxDataArrayBytes);
     } else {
 	codePtr->auxDataArrayPtr = NULL;
     }
@@ -2501,11 +2070,11 @@ TclInitByteCodeObj(
     EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
 #else
     nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
-    if (((size_t)(nextPtr - p)) != cmdLocBytes) {
-	Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %lu != expected size %lu", (unsigned long)(nextPtr - p), (unsigned long)cmdLocBytes);
+    if (((size_t)(nextPtr - p)) != cmdLocBytes) {	
+	panic("TclInitByteCodeObj: encoded cmd location bytes %ld != expected size %ld\n", (nextPtr - p), cmdLocBytes);
     }
 #endif
-
+    
     /*
      * Record various compilation-related statistics about the new ByteCode
      * structure. Don't include overhead for statistics-related fields.
@@ -2514,30 +2083,116 @@ TclInitByteCodeObj(
 #ifdef TCL_COMPILE_STATS
     codePtr->structureSize = structureSize
 	    - (sizeof(size_t) + sizeof(Tcl_Time));
-    Tcl_GetTime(&codePtr->createTime);
-
+    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.
      */
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.otherValuePtr = codePtr;
+	    
+    if ((objPtr->typePtr != NULL) &&
+	    (objPtr->typePtr->freeIntRepProc != NULL)) {
+	(*objPtr->typePtr->freeIntRepProc)(objPtr);
+    }
+    objPtr->internalRep.otherValuePtr = (VOID *) codePtr;
     objPtr->typePtr = &tclByteCodeType;
 
-    /*
-     * TIP #280. Associate the extended per-word line information with the
+#ifdef TCL_TIP280
+    /* 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, codePtr,
-	    &isNew), envPtr->extCmdMapPtr);
+    Tcl_SetHashValue (Tcl_CreateHashEntry (iPtr->lineBCPtr, (char*) codePtr, &new),
+		      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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-    codePtr->localCachePtr = NULL;
+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);
 }
 
 /*
@@ -2554,76 +2209,49 @@ TclInitByteCodeObj(
  * 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(
-    register const char *name,	/* Points to first character of the name of a
-				 * scalar or array variable. If NULL, a
+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
 				 * 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. */
-    CompileEnv *envPtr)		/* Points to the current compile environment*/
+    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
+				 * containing the variable reference. */
 {
     register CompiledLocal *localPtr;
     int localVar = -1;
     register int i;
-    Proc *procPtr;
 
     /*
      * If not creating a temporary, does a local variable of the specified
      * name already exist?
      */
 
-    procPtr = envPtr->procPtr;
-
-    if (procPtr == NULL) {
-	/*
-	 * Compiling a non-body script: give it read access to the LVT in the
-	 * current localCache
-	 */
-
-	LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
-	const char *localName;
-	Tcl_Obj **varNamePtr;
-	int len;
-
-	if (!cachePtr || !name) {
-	    return -1;
-	}
-
-	varNamePtr = &cachePtr->varName0;
-	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
-	    if (*varNamePtr) {
-		localName = Tcl_GetStringFromObj(*varNamePtr, &len);
-		if ((len == nameBytes) && !strncmp(name, localName, len)) {
-		    return i;
-		}
-	    }
-	}
-	return -1;
-    }
-
-    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;
 		}
 	    }
@@ -2634,10 +2262,12 @@ TclFindCompiledLocal(
     /*
      * Create a new variable if appropriate.
      */
-
+    
     if (create || (name == NULL)) {
 	localVar = procPtr->numCompiledLocals;
-	localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1);
+	localPtr = (CompiledLocal *) ckalloc((unsigned) 
+	        (sizeof(CompiledLocal) - sizeof(localPtr->name)
+		+ nameBytes+1));
 	if (procPtr->firstLocalPtr == NULL) {
 	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
 	} else {
@@ -2647,7 +2277,7 @@ TclFindCompiledLocal(
 	localPtr->nextPtr = NULL;
 	localPtr->nameLength = nameBytes;
 	localPtr->frameIndex = localVar;
-	localPtr->flags = 0;
+	localPtr->flags = flags | VAR_UNDEFINED;
 	if (name == NULL) {
 	    localPtr->flags |= VAR_TEMPORARY;
 	}
@@ -2655,7 +2285,8 @@ TclFindCompiledLocal(
 	localPtr->resolveInfo = NULL;
 
 	if (name != NULL) {
-	    memcpy(localPtr->name, name, (size_t) nameBytes);
+	    memcpy((VOID *) localPtr->name, (VOID *) name,
+	            (size_t) nameBytes);
 	}
 	localPtr->name[nameBytes] = '\0';
 	procPtr->numCompiledLocals++;
@@ -2666,57 +2297,167 @@ TclFindCompiledLocal(
 /*
  *----------------------------------------------------------------------
  *
- * TclExpandCodeArray --
+ * TclInitCompiledLocals --
  *
- *	Procedure that uses malloc to allocate more storage for a CompileEnv's
- *	code array.
+ *	This routine is invoked in order to initialize the compiled
+ *	locals table for a new call frame.
  *
  * Results:
  *	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.
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclExpandCodeArray(
-    void *envArgPtr)		/* Points to the CompileEnv whose code array
-				 * must be enlarged. */
+TclInitCompiledLocals(interp, framePtr, nsPtr)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    CallFrame *framePtr;	/* Call frame to initialize. */
+    Namespace *nsPtr;		/* Pointer to current namespace. */
 {
-    CompileEnv *envPtr = envArgPtr;
-				/* The CompileEnv containing the code array to
-				 * be doubled in size. */
+    register CompiledLocal *localPtr;
+    Interp *iPtr = (Interp*) interp;
+    Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
+    Var *varPtr = framePtr->compiledLocals;
+    Var *resolvedVarPtr;
+    ResolverScheme *resPtr;
+    int result;
 
     /*
-     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
-     * code bytes are stored between envPtr->codeStart and envPtr->codeNext-1
-     * [inclusive].
+     * 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.
      */
 
-    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
-    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
+    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;
+	    }
+	}
 
-    if (envPtr->mallocedCodeArray) {
-	envPtr->codeStart = ckrealloc(envPtr->codeStart, newBytes);
-    } else {
 	/*
-	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a
-	 * ckrealloc equivalent for ourselves.
+	 * Now invoke the resolvers to determine the exact variables that
+	 * should be used.
 	 */
 
-	unsigned char *newPtr = ckalloc(newBytes);
+        resVarInfo = localPtr->resolveInfo;
+        resolvedVarPtr = NULL;
 
-	memcpy(newPtr, envPtr->codeStart, currBytes);
-	envPtr->codeStart = newPtr;
-	envPtr->mallocedCodeArray = 1;
+        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.
+ *
+ * Results:
+ *	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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclExpandCodeArray(envArgPtr)
+    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. */
 
-    envPtr->codeNext = envPtr->codeStart + currBytes;
-    envPtr->codeEnd = envPtr->codeStart + newBytes;
+    /*
+     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
+     * 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);
+
+    /*
+     * 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 = newPtr;
+    envPtr->codeNext = (newPtr + currBytes);
+    envPtr->codeEnd  = (newPtr + newBytes);
+    envPtr->mallocedCodeArray = 1;
 }
 
 /*
@@ -2724,37 +2465,37 @@ TclExpandCodeArray(
  *
  * 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(
-    CompileEnv *envPtr,		/* Points to the compilation environment
+EnterCmdStartData(envPtr, cmdIndex, srcOffset, codeOffset)
+    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)) {
-	Tcl_Panic("EnterCmdStartData: bad command index %d", cmdIndex);
+	panic("EnterCmdStartData: bad command index %d\n", cmdIndex);
     }
-
+    
     if (cmdIndex >= envPtr->cmdMapEnd) {
 	/*
 	 * Expand the command location array by allocating more storage from
@@ -2763,34 +2504,32 @@ EnterCmdStartData(
 	 */
 
 	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);
-
+	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);
 	if (envPtr->mallocedCmdMap) {
-	    envPtr->cmdMapPtr = ckrealloc(envPtr->cmdMapPtr, newBytes);
-	} else {
-	    /*
-	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a
-	     * ckrealloc equivalent for ourselves.
-	     */
-
-	    CmdLocation *newPtr = ckalloc(newBytes);
-
-	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
-	    envPtr->cmdMapPtr = newPtr;
-	    envPtr->mallocedCmdMap = 1;
+	    ckfree((char *) envPtr->cmdMapPtr);
 	}
+	envPtr->cmdMapPtr = (CmdLocation *) newPtr;
 	envPtr->cmdMapEnd = newElems;
+	envPtr->mallocedCmdMap = 1;
     }
 
     if (cmdIndex > 0) {
 	if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
-	    Tcl_Panic("EnterCmdStartData: cmd map not sorted by code offset");
+	    panic("EnterCmdStartData: cmd map not sorted by code offset");
 	}
     }
 
-    cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
+    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
     cmdLocPtr->codeOffset = codeOffset;
     cmdLocPtr->srcOffset = srcOffset;
     cmdLocPtr->numSrcBytes = -1;
@@ -2811,118 +2550,138 @@ EnterCmdStartData(
  *
  * 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(
-    CompileEnv *envPtr,		/* Points to the compilation environment
+EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
+    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)) {
-	Tcl_Panic("EnterCmdExtentData: bad command index %d", cmdIndex);
+	panic("EnterCmdExtentData: bad command index %d\n", cmdIndex);
     }
-
+    
     if (cmdIndex > envPtr->cmdMapEnd) {
-	Tcl_Panic("EnterCmdExtentData: missing start data for command %d",
-		cmdIndex);
+	panic("EnterCmdExtentData: missing start data for command %d\n",
+	        cmdIndex);
     }
 
-    cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
+    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
     cmdLocPtr->numSrcBytes = numSrcBytes;
     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(
-    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, *wordNext;
+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;
 
     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 newBytes = newElems * sizeof(ECL);
+	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);
 
-	eclPtr->loc = ckrealloc(eclPtr->loc, newBytes);
+	/*
+	 * 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->nloc = newElems;
     }
 
-    ePtr = &eclPtr->loc[eclPtr->nuloc];
+    ePtr            = &eclPtr->loc [eclPtr->nuloc];
     ePtr->srcOffset = srcOffset;
-    ePtr->line = ckalloc(numWords * sizeof(int));
-    ePtr->next = ckalloc(numWords * sizeof(int *));
-    ePtr->nline = numWords;
-    wwlines = 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) {
-	TclAdvanceLines(&wordLine, last, tokenPtr->start);
-	TclAdvanceContinuations(&wordLine, &wordNext,
-		tokenPtr->start - envPtr->source);
-	wwlines[wordIdx] =
-		(TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1);
-	ePtr->line[wordIdx] = wordLine;
-	ePtr->next[wordIdx] = wordNext;
+    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;
 	last = tokenPtr->start;
     }
 
     *wlines = wwlines;
     eclPtr->nuloc ++;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
@@ -2936,55 +2695,56 @@ EnterCmdWordData(
  *	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(
-    ExceptionRangeType type,	/* The kind of ExceptionRange desired. */
-    register CompileEnv *envPtr)/* Points to CompileEnv for which to create a
-				 * new ExceptionRange structure. */
+TclCreateExceptRange(type, envPtr)
+    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) {
-	    envPtr->exceptArrayPtr =
-		    ckrealloc(envPtr->exceptArrayPtr, newBytes);
-	} else {
-	    /*
-	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
-	     * code a ckrealloc equivalent for ourselves.
-	     */
-
-	    ExceptionRange *newPtr = ckalloc(newBytes);
-
-	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
-	    envPtr->exceptArrayPtr = newPtr;
-	    envPtr->mallocedExceptArray = 1;
+	    ckfree((char *) envPtr->exceptArrayPtr);
 	}
+	envPtr->exceptArrayPtr = (ExceptionRange *) newPtr;
 	envPtr->exceptArrayEnd = newElems;
+	envPtr->mallocedExceptArray = 1;
     }
     envPtr->exceptArrayNext++;
-
-    rangePtr = &envPtr->exceptArrayPtr[index];
+    
+    rangePtr = &(envPtr->exceptArrayPtr[index]);
     rangePtr->type = type;
     rangePtr->nestingLevel = envPtr->exceptDepth;
     rangePtr->codeOffset = -1;
@@ -3000,8 +2760,8 @@ TclCreateExceptRange(
  *
  * 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.
  *
@@ -3009,60 +2769,57 @@ TclCreateExceptRange(
  *	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 clientData,	/* The compilation auxiliary data to store in
-				 * the new aux data record. */
-    const AuxDataType *typePtr,	/* Pointer to the type to attach to this
-				 * AuxData */
-    register CompileEnv *envPtr)/* Points to the CompileEnv for which a new
+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
 				 * aux data structure is to be allocated. */
 {
     int index;			/* Index for the new AuxData structure. */
     register AuxData *auxDataPtr;
-				/* Points to the new AuxData structure */
-
+    				/* 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) {
-	    envPtr->auxDataArrayPtr =
-		    ckrealloc(envPtr->auxDataArrayPtr, newBytes);
-	} else {
-	    /*
-	     * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
-	     * code a ckrealloc equivalent for ourselves.
-	     */
-
-	    AuxData *newPtr = ckalloc(newBytes);
-
-	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
-	    envPtr->auxDataArrayPtr = newPtr;
-	    envPtr->mallocedAuxDataArray = 1;
+	    ckfree((char *) envPtr->auxDataArrayPtr);
 	}
+	envPtr->auxDataArrayPtr = newPtr;
 	envPtr->auxDataArrayEnd = newElems;
+	envPtr->mallocedAuxDataArray = 1;
     }
     envPtr->auxDataArrayNext++;
-
-    auxDataPtr = &envPtr->auxDataArrayPtr[index];
+    
+    auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
     auxDataPtr->clientData = clientData;
     auxDataPtr->type = typePtr;
     return index;
@@ -3073,8 +2830,8 @@ TclCreateAuxData(
  *
  * 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.
@@ -3086,14 +2843,14 @@ TclCreateAuxData(
  */
 
 void
-TclInitJumpFixupArray(
-    register JumpFixupArray *fixupArrayPtr)
-				/* Points to the JumpFixupArray structure to
-				 * initialize. */
+TclInitJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to initialize. */
 {
     fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
     fixupArrayPtr->next = 0;
-    fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1;
+    fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
     fixupArrayPtr->mallocedArray = 0;
 }
 
@@ -3102,8 +2859,8 @@ TclInitJumpFixupArray(
  *
  * 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.
@@ -3111,43 +2868,41 @@ TclInitJumpFixupArray(
  * 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(
-    register JumpFixupArray *fixupArrayPtr)
-				/* Points to the JumpFixupArray structure to
-				 * enlarge. */
+TclExpandJumpFixupArray(fixupArrayPtr)
+    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) {
-	fixupArrayPtr->fixup = ckrealloc(fixupArrayPtr->fixup, newBytes);
-    } else {
-	/*
-	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a
-	 * ckrealloc equivalent for ourselves.
-	 */
-
-	JumpFixup *newPtr = ckalloc(newBytes);
-
-	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
-	fixupArrayPtr->fixup = newPtr;
-	fixupArrayPtr->mallocedArray = 1;
+	ckfree((char *) fixupArrayPtr->fixup);
     }
+    fixupArrayPtr->fixup = (JumpFixup *) newPtr;
     fixupArrayPtr->end = newElems;
+    fixupArrayPtr->mallocedArray = 1;
 }
 
 /*
@@ -3167,13 +2922,13 @@ TclExpandJumpFixupArray(
  */
 
 void
-TclFreeJumpFixupArray(
-    register JumpFixupArray *fixupArrayPtr)
-				/* Points to the JumpFixupArray structure to
-				 * free. */
+TclFreeJumpFixupArray(fixupArrayPtr)
+    register JumpFixupArray *fixupArrayPtr;
+				 /* Points to the JumpFixupArray structure
+				  * to free. */
 {
     if (fixupArrayPtr->mallocedArray) {
-	ckfree(fixupArrayPtr->fixup);
+	ckfree((char *) fixupArrayPtr->fixup);
     }
 }
 
@@ -3185,27 +2940,27 @@ TclFreeJumpFixupArray(
  *	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(
-    CompileEnv *envPtr,		/* Points to the CompileEnv structure that
+TclEmitForwardJump(envPtr, jumpType, jumpFixupPtr)
+    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. */
 {
@@ -3213,15 +2968,15 @@ TclEmitForwardJump(
      * 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->codeOffset = (envPtr->codeNext - envPtr->codeStart);
     jumpFixupPtr->cmdIndex = envPtr->numCommands;
     jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;
-
+    
     switch (jumpType) {
     case TCL_UNCONDITIONAL_JUMP:
 	TclEmitInstInt1(INST_JUMP1, 0, envPtr);
@@ -3240,43 +2995,45 @@ TclEmitForwardJump(
  *
  * 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(
-    CompileEnv *envPtr,		/* Points to the CompileEnv structure that
+TclFixupForwardJump(envPtr, jumpFixupPtr, jumpDist, distThreshold)
+    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 instr. */
-    int distThreshold)		/* Maximum distance before the two byte jump
-				 * is grown to five bytes. */
+    int jumpDist;		/* Jump distance to set in jump
+				 * instruction. */
+    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 numBytes;
-
+    unsigned int numBytes;
+    
     if (jumpDist <= distThreshold) {
-	jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
+	jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
 	switch (jumpFixupPtr->jumpType) {
 	case TCL_UNCONDITIONAL_JUMP:
 	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
@@ -3292,16 +3049,16 @@ TclFixupForwardJump(
     }
 
     /*
-     * 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;
+    jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
     numBytes = envPtr->codeNext-jumpPc-2;
     p = jumpPc+2;
     memmove(p+3, p, numBytes);
@@ -3319,26 +3076,26 @@ TclFixupForwardJump(
 	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;
+	    (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];
-
+	ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[k]);
 	rangePtr->codeOffset += 3;
+	
 	switch (rangePtr->type) {
 	case LOOP_EXCEPTION_RANGE:
 	    rangePtr->breakOffset += 3;
@@ -3350,74 +3107,10 @@ TclFixupForwardJump(
 	    rangePtr->catchOffset += 3;
 	    break;
 	default:
-	    Tcl_Panic("TclFixupForwardJump: bad ExceptionRange type %d",
-		    rangePtr->type);
+	    panic("TclFixupForwardJump: bad ExceptionRange type %d\n",
+	            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 (map);
-    }
-
     return 1;			/* the jump was grown */
 }
 
@@ -3426,9 +3119,9 @@ TclFixupForwardJump(
  *
  * 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
@@ -3440,8 +3133,8 @@ TclFixupForwardJump(
  *----------------------------------------------------------------------
  */
 
-const void * /* == InstructionDesc* == */
-TclGetInstructionTable(void)
+void * /* == InstructionDesc* == */
+TclGetInstructionTable()
 {
     return &tclInstructionTable[0];
 }
@@ -3451,32 +3144,32 @@ TclGetInstructionTable(void)
  *
  * 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(
-    const AuxDataType *typePtr)	/* Information about object type; storage must
-				 * be statically allocated (must live forever;
-				 * will not be deallocated). */
+TclRegisterAuxDataType(typePtr)
+    AuxDataType *typePtr;	/* Information about object type;
+                             * storage must be statically
+                             * allocated (must live forever). */
 {
     register Tcl_HashEntry *hPtr;
-    int isNew;
+    int new;
 
     Tcl_MutexLock(&tableMutex);
     if (!auxDataTypeTableInitialized) {
-	TclInitAuxDataTypeTable();
+        TclInitAuxDataTypeTable();
     }
 
     /*
@@ -3484,17 +3177,17 @@ TclRegisterAuxDataType(
      */
 
     hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
-    if (hPtr != NULL) {
-	Tcl_DeleteHashEntry(hPtr);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        Tcl_DeleteHashEntry(hPtr);
     }
 
     /*
      * Now insert the new object type.
      */
 
-    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &isNew);
-    if (isNew) {
-	Tcl_SetHashValue(hPtr, typePtr);
+    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &new);
+    if (new) {
+        Tcl_SetHashValue(hPtr, typePtr);
     }
     Tcl_MutexUnlock(&tableMutex);
 }
@@ -3516,21 +3209,21 @@ TclRegisterAuxDataType(
  *----------------------------------------------------------------------
  */
 
-const AuxDataType *
-TclGetAuxDataType(
-    const char *typeName)	/* Name of AuxData type to look up. */
+AuxDataType *
+TclGetAuxDataType(typeName)
+    char *typeName;		/* Name of AuxData type to look up. */
 {
     register Tcl_HashEntry *hPtr;
-    const AuxDataType *typePtr = NULL;
+    AuxDataType *typePtr = NULL;
 
     Tcl_MutexLock(&tableMutex);
     if (!auxDataTypeTableInitialized) {
-	TclInitAuxDataTypeTable();
+        TclInitAuxDataTypeTable();
     }
 
     hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
-    if (hPtr != NULL) {
-	typePtr = Tcl_GetHashValue(hPtr);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
     }
     Tcl_MutexUnlock(&tableMutex);
 
@@ -3542,8 +3235,8 @@ TclGetAuxDataType(
  *
  * 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:
@@ -3557,7 +3250,7 @@ TclGetAuxDataType(
  */
 
 void
-TclInitAuxDataTypeTable(void)
+TclInitAuxDataTypeTable()
 {
     /*
      * The table mutex must already be held before this routine is invoked.
@@ -3567,12 +3260,10 @@ TclInitAuxDataTypeTable(void)
     Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);
 
     /*
-     * There are only two AuxData type at this time, so register them here.
+     * There is only one AuxData type at this time, so register it here.
      */
 
     TclRegisterAuxDataType(&tclForeachInfoType);
-    TclRegisterAuxDataType(&tclJumptableInfoType);
-    TclRegisterAuxDataType(&tclDictUpdateInfoType);
 }
 
 /*
@@ -3580,10 +3271,10 @@ TclInitAuxDataTypeTable(void)
  *
  * 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.
@@ -3595,12 +3286,12 @@ TclInitAuxDataTypeTable(void)
  */
 
 void
-TclFinalizeAuxDataTypeTable(void)
+TclFinalizeAuxDataTypeTable()
 {
     Tcl_MutexLock(&tableMutex);
     if (auxDataTypeTableInitialized) {
-	Tcl_DeleteHashTable(&auxDataTypeTable);
-	auxDataTypeTableInitialized = 0;
+        Tcl_DeleteHashTable(&auxDataTypeTable);
+        auxDataTypeTableInitialized = 0;
     }
     Tcl_MutexUnlock(&tableMutex);
 }
@@ -3623,57 +3314,57 @@ TclFinalizeAuxDataTypeTable(void)
  */
 
 static int
-GetCmdLocEncodingSize(
-    CompileEnv *envPtr)		/* Points to compilation environment structure
-				 * containing the CmdLocation structure to
-				 * encode. */
+GetCmdLocEncodingSize(envPtr)
+     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;
     prevCodeOffset = prevSrcOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
-	codeDelta = mapPtr[i].codeOffset - prevCodeOffset;
+	codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
 	if (codeDelta < 0) {
-	    Tcl_Panic("GetCmdLocEncodingSize: bad code offset");
+	    panic("GetCmdLocEncodingSize: bad code offset");
 	} else if (codeDelta <= 127) {
 	    codeDeltaNext++;
 	} else {
-	    codeDeltaNext += 5;	/* 1 byte for 0xFF, 4 for positive delta */
+	    codeDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for positive delta */
 	}
 	prevCodeOffset = mapPtr[i].codeOffset;
 
 	codeLen = mapPtr[i].numCodeBytes;
 	if (codeLen < 0) {
-	    Tcl_Panic("GetCmdLocEncodingSize: bad code length");
+	    panic("GetCmdLocEncodingSize: bad code length");
 	} else if (codeLen <= 127) {
 	    codeLengthNext++;
 	} else {
-	    codeLengthNext += 5;/* 1 byte for 0xFF, 4 for length */
+	    codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
 	}
 
-	srcDelta = mapPtr[i].srcOffset - prevSrcOffset;
-	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
+	srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
+	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
 	    srcDeltaNext++;
 	} else {
-	    srcDeltaNext += 5;	/* 1 byte for 0xFF, 4 for delta */
+	    srcDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for delta */
 	}
 	prevSrcOffset = mapPtr[i].srcOffset;
 
 	srcLen = mapPtr[i].numSrcBytes;
 	if (srcLen < 0) {
-	    Tcl_Panic("GetCmdLocEncodingSize: bad source length");
+	    panic("GetCmdLocEncodingSize: bad source length");
 	} else if (srcLen <= 127) {
 	    srcLengthNext++;
 	} else {
-	    srcLengthNext += 5;	/* 1 byte for 0xFF, 4 for length */
+	    srcLengthNext += 5;	 /* 1 byte for 0xFF, 4 for length */
 	}
     }
 
@@ -3685,8 +3376,8 @@ GetCmdLocEncodingSize(
  *
  * 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:
@@ -3694,30 +3385,30 @@ GetCmdLocEncodingSize(
  *	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(
-    CompileEnv *envPtr,		/* Points to compilation environment structure
-				 * containing the CmdLocation structure to
-				 * encode. */
-    ByteCode *codePtr,		/* ByteCode in which to encode envPtr's
+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
 				 * 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.
      */
@@ -3725,9 +3416,9 @@ EncodeCmdLocMap(
     codePtr->codeDeltaStart = p;
     prevOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
-	codeDelta = mapPtr[i].codeOffset - prevOffset;
+	codeDelta = (mapPtr[i].codeOffset - prevOffset);
 	if (codeDelta < 0) {
-	    Tcl_Panic("EncodeCmdLocMap: bad code offset");
+	    panic("EncodeCmdLocMap: bad code offset");
 	} else if (codeDelta <= 127) {
 	    TclStoreInt1AtPtr(codeDelta, p);
 	    p++;
@@ -3748,7 +3439,7 @@ EncodeCmdLocMap(
     for (i = 0;  i < numCmds;  i++) {
 	codeLen = mapPtr[i].numCodeBytes;
 	if (codeLen < 0) {
-	    Tcl_Panic("EncodeCmdLocMap: bad code length");
+	    panic("EncodeCmdLocMap: bad code length");
 	} else if (codeLen <= 127) {
 	    TclStoreInt1AtPtr(codeLen, p);
 	    p++;
@@ -3767,8 +3458,8 @@ EncodeCmdLocMap(
     codePtr->srcDeltaStart = p;
     prevOffset = 0;
     for (i = 0;  i < numCmds;  i++) {
-	srcDelta = mapPtr[i].srcOffset - prevOffset;
-	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
+	srcDelta = (mapPtr[i].srcOffset - prevOffset);
+	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
 	    TclStoreInt1AtPtr(srcDelta, p);
 	    p++;
 	} else {
@@ -3788,7 +3479,7 @@ EncodeCmdLocMap(
     for (i = 0;  i < numCmds;  i++) {
 	srcLen = mapPtr[i].numSrcBytes;
 	if (srcLen < 0) {
-	    Tcl_Panic("EncodeCmdLocMap: bad source length");
+	    panic("EncodeCmdLocMap: bad source length");
 	} else if (srcLen <= 127) {
 	    TclStoreInt1AtPtr(srcLen, p);
 	    p++;
@@ -3799,7 +3490,7 @@ EncodeCmdLocMap(
 	    p += 4;
 	}
     }
-
+    
     return p;
 }
 
@@ -3809,227 +3500,98 @@ EncodeCmdLocMap(
  *
  * TclPrintByteCodeObj --
  *
- *	This procedure prints ("disassembles") the instructions of a bytecode
- *	object to stdout.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclPrintByteCodeObj(
-    Tcl_Interp *interp,		/* Used only for Tcl_GetStringFromObj. */
-    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
-{
-    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. */
-    const 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.
+ *	This procedure prints ("disassembles") the instructions of a
+ *	bytecode object to stdout.
  *
  * 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. */
+TclPrintByteCodeObj(interp, objPtr)
+    Tcl_Interp *interp;		/* Used only for Tcl_GetStringFromObj. */
+    Tcl_Obj *objPtr;		/* The bytecode object to disassemble. */
 {
-    ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+    ByteCode* codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
     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 bufferObj;	/* Already freed. */
+	return;			/* already freed */
     }
 
     codeStart = codePtr->codeStart;
-    codeLimit = codeStart + codePtr->numCodeBytes;
+    codeLimit = (codeStart + codePtr->numCodeBytes);
     numCmds = codePtr->numCommands;
 
     /*
      * Print header lines describing the ByteCode.
      */
 
-    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,
+    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,
 	    iPtr->compileEpoch);
-    Tcl_AppendToObj(bufferObj, "  Source ", -1);
-    PrintSourceToObj(bufferObj, codePtr->source,
+    fprintf(stdout, "  Source ");
+    TclPrintSource(stdout, codePtr->source,
 	    TclMin(codePtr->numSrcBytes, 55));
-    Tcl_AppendPrintfToObj(bufferObj,
-	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+    fprintf(stdout, "\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?
-		    codePtr->structureSize/(float)codePtr->numSrcBytes :
-#endif
+	    (codePtr->numSrcBytes?
+	            ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
+#else
 	    0.0);
-
+#endif
 #ifdef TCL_COMPILE_STATS
-    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)),
+    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))),
 	    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;
-
-	sprintf(ptrBuf1, "%p", procPtr);
-	Tcl_AppendPrintfToObj(bufferObj,
-		"  Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
-		ptrBuf1, procPtr->refCount, procPtr->numArgs,
+	fprintf(stdout,
+	        "  Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
+		(unsigned int) procPtr, procPtr->refCount, procPtr->numArgs,
 		numCompiledLocals);
 	if (numCompiledLocals > 0) {
 	    CompiledLocal *localPtr = procPtr->firstLocalPtr;
-
 	    for (i = 0;  i < numCompiledLocals;  i++) {
-		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" : "");
+		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" : ""));
 		if (TclIsVarTemporary(localPtr)) {
-		    Tcl_AppendToObj(bufferObj, "\n", -1);
+		    fprintf(stdout,	"\n");
 		} else {
-		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
-			    localPtr->name);
+		    fprintf(stdout,	", \"%s\"\n", localPtr->name);
 		}
 		localPtr = localPtr->nextPtr;
 	    }
@@ -4041,60 +3603,58 @@ TclDisassembleByteCodeObj(
      */
 
     if (codePtr->numExceptRanges > 0) {
-	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
-		codePtr->numExceptRanges, codePtr->maxExceptDepth);
+	fprintf(stdout, "  Exception ranges %d, depth %d:\n",
+	        codePtr->numExceptRanges, codePtr->maxExceptDepth);
 	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
-	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
-
-	    Tcl_AppendPrintfToObj(bufferObj,
-		    "      %d: level %d, %s, pc %d-%d, ",
+	    ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]);
+	    fprintf(stdout, "      %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:
-		Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
-			rangePtr->continueOffset, rangePtr->breakOffset);
+		fprintf(stdout,	"continue %d, break %d\n",
+		        rangePtr->continueOffset, rangePtr->breakOffset);
 		break;
 	    case CATCH_EXCEPTION_RANGE:
-		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
-			rangePtr->catchOffset);
+		fprintf(stdout,	"catch %d\n", rangePtr->catchOffset);
 		break;
 	    default:
-		Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
-			rangePtr->type);
+		panic("TclPrintByteCodeObj: bad ExceptionRange type %d\n",
+		        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) {
-	    Tcl_AppendToObj(bufferObj, "    ", -1);
-	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
 	}
-	return bufferObj;
+	return;
     }
-
+    
     /*
-     * 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.
      */
 
-    Tcl_AppendPrintfToObj(bufferObj, "  Commands %d:", numCmds);
+    fprintf(stdout, "  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) *codeDeltaNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
 	    codeDeltaNext++;
 	    delta = TclGetInt4AtPtr(codeDeltaNext);
 	    codeDeltaNext += 4;
@@ -4104,7 +3664,7 @@ TclDisassembleByteCodeObj(
 	}
 	codeOffset += delta;
 
-	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
 	    codeLengthNext++;
 	    codeLen = TclGetInt4AtPtr(codeLengthNext);
 	    codeLengthNext += 4;
@@ -4112,8 +3672,8 @@ TclDisassembleByteCodeObj(
 	    codeLen = TclGetInt1AtPtr(codeLengthNext);
 	    codeLengthNext++;
 	}
-
-	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+	
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
 	    srcDeltaNext++;
 	    delta = TclGetInt4AtPtr(srcDeltaNext);
 	    srcDeltaNext += 4;
@@ -4123,7 +3683,7 @@ TclDisassembleByteCodeObj(
 	}
 	srcOffset += delta;
 
-	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
 	    srcLengthNext++;
 	    srcLen = TclGetInt4AtPtr(srcLengthNext);
 	    srcLengthNext += 4;
@@ -4131,29 +3691,29 @@ TclDisassembleByteCodeObj(
 	    srcLen = TclGetInt1AtPtr(srcLengthNext);
 	    srcLengthNext++;
 	}
-
-	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
-		((i % 2)? "     " : "\n   "),
+	
+	fprintf(stdout,	"%s%4d: pc %d-%d, src %d-%d",
+		((i % 2)? "   	" : "\n   "),
 		(i+1), codeOffset, (codeOffset + codeLen - 1),
 		srcOffset, (srcOffset + srcLen - 1));
     }
     if (numCmds > 0) {
-	Tcl_AppendToObj(bufferObj, "\n", -1);
+	fprintf(stdout,	"\n");
     }
-
+    
     /*
-     * 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) *codeDeltaNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
 	    codeDeltaNext++;
 	    delta = TclGetInt4AtPtr(codeDeltaNext);
 	    codeDeltaNext += 4;
@@ -4163,7 +3723,7 @@ TclDisassembleByteCodeObj(
 	}
 	codeOffset += delta;
 
-	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
 	    srcDeltaNext++;
 	    delta = TclGetInt4AtPtr(srcDeltaNext);
 	    srcDeltaNext += 4;
@@ -4173,7 +3733,7 @@ TclDisassembleByteCodeObj(
 	}
 	srcOffset += delta;
 
-	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
 	    srcLengthNext++;
 	    srcLen = TclGetInt4AtPtr(srcLengthNext);
 	    srcLengthNext += 4;
@@ -4185,16 +3745,16 @@ TclDisassembleByteCodeObj(
 	/*
 	 * Print instructions before command i.
 	 */
-
+	
 	while ((pc-codeStart) < codeOffset) {
-	    Tcl_AppendToObj(bufferObj, "    ", -1);
-	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
 	}
 
-	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
-	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
-		TclMin(srcLen, 55));
-	Tcl_AppendToObj(bufferObj, "\n", -1);
+	fprintf(stdout, "  Command %d: ", (i+1));
+	TclPrintSource(stdout, (codePtr->source + srcOffset),
+	        TclMin(srcLen, 55));
+	fprintf(stdout, "\n");
     }
     if (pc < codeLimit) {
 	/*
@@ -4202,368 +3762,225 @@ TclDisassembleByteCodeObj(
 	 */
 
 	while (pc < codeLimit) {
-	    Tcl_AppendToObj(bufferObj, "    ", -1);
-	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	    fprintf(stdout, "    ");
+	    pc += TclPrintInstruction(codePtr, pc);
 	}
     }
-    return bufferObj;
 }
+#endif /* TCL_COMPILE_DEBUG */
 
 /*
  *----------------------------------------------------------------------
  *
- * FormatInstruction --
+ * TclPrintInstruction --
+ *
+ *	This procedure prints ("disassembles") one instruction from a
+ *	bytecode object to stdout.
  *
- *	Appends a representation of a bytecode instruction to a Tcl_Obj.
+ * Results:
+ *	Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-FormatInstruction(
-    ByteCode *codePtr,		/* Bytecode containing the instruction. */
-    const unsigned char *pc,	/* Points to first byte of instruction. */
-    Tcl_Obj *bufferObj)		/* Object to append instruction info to. */
+int
+TclPrintInstruction(codePtr, pc)
+    ByteCode* codePtr;		/* Bytecode containing the instruction. */
+    unsigned char *pc;		/* Points to first byte of instruction. */
 {
     Proc *procPtr = codePtr->procPtr;
     unsigned char opCode = *pc;
-    register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
+    register InstructionDesc *instDesc = &tclInstructionTable[opCode];
     unsigned char *codeStart = codePtr->codeStart;
-    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);
+    unsigned int pcOffset = (pc - codeStart);
+    int opnd, i, j;
+    
+    fprintf(stdout, "(%u) %s ", pcOffset, instDesc->name);
     for (i = 0;  i < instDesc->numOperands;  i++) {
 	switch (instDesc->opTypes[i]) {
 	case OPERAND_INT1:
-	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
-	    if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
-		    || opCode == INST_JUMP_FALSE1) {
-		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+	    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);
 	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
 	    break;
 	case OPERAND_INT4:
-	    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);
+	    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);
 	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
 	    break;
 	case OPERAND_UINT1:
-	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
-	    if (opCode == INST_PUSH1) {
-		suffixObj = codePtr->objArrayPtr[opnd];
+	    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);
 	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
 	    break;
-	case OPERAND_AUX4:
 	case OPERAND_UINT4:
-	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+	    opnd = TclGetUInt4AtPtr(pc+1+i);
 	    if (opCode == INST_PUSH4) {
-		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) {
+		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;
 		if (opnd >= localCt) {
-		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
-			    (unsigned) 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)) {
-		    sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
+		    fprintf(stdout, "%u	# temp var %u",
+			    (unsigned int) opnd, (unsigned int) opnd);
 		} else {
-		    sprintf(suffixBuffer, "var ");
-		    suffixSrc = localPtr->name;
+		    fprintf(stdout, "%u	# var ", (unsigned int) opnd);
+		    TclPrintSource(stdout, localPtr->name, 40);
 		}
+	    } else {
+		fprintf(stdout, "%u ", (unsigned int) opnd);
 	    }
-	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
 	    break;
 	case OPERAND_NONE:
 	default:
 	    break;
 	}
     }
-    if (suffixObj) {
-	const 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;
+    fprintf(stdout, "\n");
+    return instDesc->numBytes;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclGetInnerContext --
- *
- *	If possible, returns a list capturing the inner context. Otherwise
- *	return NULL.
+ * TclPrintObject --
  *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclGetInnerContext(
-    Tcl_Interp *interp,
-    const unsigned char *pc,
-    Tcl_Obj **tosPtr)
-{
-    int objc = 0, off = 0;
-    Tcl_Obj *result;
-    Interp *iPtr = (Interp *) interp;
-
-    switch (*pc) {
-    case INST_STR_LEN:
-    case INST_LNOT:
-    case INST_BITNOT:
-    case INST_UMINUS:
-    case INST_UPLUS:
-    case INST_TRY_CVT_TO_NUMERIC:
-    case INST_EXPAND_STKTOP:
-    case INST_EXPR_STK:
-        objc = 1;
-        break;
-
-    case INST_LIST_IN:
-    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
-    case INST_STR_EQ:
-    case INST_STR_NEQ:		/* String (in)equality check */
-    case INST_STR_CMP:		/* String compare. */
-    case INST_STR_INDEX:
-    case INST_STR_MATCH:
-    case INST_REGEXP:
-    case INST_EQ:
-    case INST_NEQ:
-    case INST_LT:
-    case INST_GT:
-    case INST_LE:
-    case INST_GE:
-    case INST_MOD:
-    case INST_LSHIFT:
-    case INST_RSHIFT:
-    case INST_BITOR:
-    case INST_BITXOR:
-    case INST_BITAND:
-    case INST_EXPON:
-    case INST_ADD:
-    case INST_SUB:
-    case INST_DIV:
-    case INST_MULT:
-        objc = 2;
-        break;
-
-    case INST_RETURN_STK:
-        /* early pop. TODO: dig out opt dict too :/ */
-        objc = 1;
-        break;
-
-    case INST_SYNTAX:
-    case INST_RETURN_IMM:
-        objc = 2;
-        break;
-
-    case INST_INVOKE_STK4:
-	objc = TclGetUInt4AtPtr(pc+1);
-        break;
-
-    case INST_INVOKE_STK1:
-	objc = TclGetUInt1AtPtr(pc+1);
-	break;
-    }
-
-    result = iPtr->innerContext;
-    if (Tcl_IsShared(result)) {
-        Tcl_DecrRefCount(result);
-        iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
-        Tcl_IncrRefCount(result);
-    } else {
-        int len;
-
-        /*
-         * Reset while keeping the list intrep as much as possible.
-         */
-
-	Tcl_ListObjLength(interp, result, &len);
-        Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
-    }
-    Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
-
-    for (; objc>0 ; objc--) {
-        Tcl_Obj *objPtr;
-
-        objPtr = tosPtr[1 - objc + off];
-        if (!objPtr) {
-            Tcl_Panic("InnerContext: bad tos -- appending null object");
-        }
-        if (objPtr->refCount<=0 || objPtr->refCount==0x61616161) {
-            Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
-                    objPtr);
-        }
-        Tcl_ListObjAppendElement(NULL, result, objPtr);
-    }
-
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
+ *	This procedure prints up to a specified number of characters from
+ *	the argument Tcl object's string representation to a specified file.
  *
- * TclNewInstNameObj --
+ * Results:
+ *	None.
  *
- *	Creates a new InstName Tcl_Obj based on the given instruction
+ * Side effects:
+ *	Outputs characters to the specified file.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-TclNewInstNameObj(
-    unsigned char inst)
+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. */
 {
-    Tcl_Obj *objPtr = Tcl_NewObj();
-
-    objPtr->typePtr = &tclInstNameType;
-    objPtr->internalRep.longValue = (long) inst;
-    objPtr->bytes = NULL;
-
-    return objPtr;
+    char *bytes;
+    int length;
+    
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * UpdateStringOfInstName --
- *
- *	Update the string representation for an instruction name object.
+ * TclPrintSource --
  *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfInstName(
-    Tcl_Obj *objPtr)
-{
-    int inst = objPtr->internalRep.longValue;
-    char *s, buf[20];
-    int len;
-
-    if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
-        sprintf(buf, "inst_%d", inst);
-        s = buf;
-    } else {
-        s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
-    }
-    len = strlen(s);
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, s, len + 1);
-    objPtr->length = len;
-}
-
-/*
- *----------------------------------------------------------------------
+ *	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.
  *
- * PrintSourceToObj --
+ * Results:
+ *	None.
  *
- *	Appends a quoted representation of a string to a Tcl_Obj.
+ * Side effects:
+ *	Outputs characters to the specified file.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
+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. */
 {
-    register const char *p;
+    register CONST char *p;
     register int i = 0;
 
-    if (stringPtr == NULL) {
-	Tcl_AppendToObj(appendObj, "\"\"", -1);
+    if (string == NULL) {
+	fprintf(outFile, "\"\"");
 	return;
     }
 
-    Tcl_AppendToObj(appendObj, "\"", -1);
-    p = stringPtr;
+    fprintf(outFile, "\"");
+    p = string;
     for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
 	switch (*p) {
-	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;
+	    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;
 	}
     }
-    Tcl_AppendToObj(appendObj, "\"", -1);
+    fprintf(outFile, "\"");
 }
 
 #ifdef TCL_COMPILE_STATS
@@ -4581,42 +3998,41 @@ PrintSourceToObj(
  *
  * 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(
-    ByteCode *codePtr)		/* Points to ByteCode structure with info
+RecordByteCodeStats(codePtr)
+    ByteCode *codePtr;		/* Points to ByteCode structure with info
 				 * to add to accumulated statistics. */
 {
     Interp *iPtr = (Interp *) *codePtr->interpHandle;
-    register ByteCodeStats *statsPtr;
+    register ByteCodeStats *statsPtr = &(iPtr->stats);
 
     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->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->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
 }
 #endif /* TCL_COMPILE_STATS */
@@ -4626,7 +4042,6 @@ RecordByteCodeStats(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
  * End:
  */
+
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 58663fd..31c1b94 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -3,19 +3,24 @@
  *
  * 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 */
 
-struct ByteCode;		/* Forward declaration. */
+#ifdef BUILD_tcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
 
 /*
  *------------------------------------------------------------------------
@@ -34,8 +39,10 @@ struct ByteCode;		/* Forward declaration. */
  * This variable is linked to the Tcl variable "tcl_traceCompile".
  */
 
-MODULE_SCOPE int 	tclTraceCompile;
+extern int 		tclTraceCompile;
+#endif
 
+#ifdef TCL_COMPILE_DEBUG
 /*
  * Variable that controls whether execution tracing is enabled and, if so,
  * what level of tracing is desired:
@@ -46,9 +53,9 @@ MODULE_SCOPE int 	tclTraceCompile;
  * This variable is linked to the Tcl variable "tcl_traceExec".
  */
 
-MODULE_SCOPE int 	tclTraceExec;
+extern int 		tclTraceExec;
 #endif
-
+
 /*
  *------------------------------------------------------------------------
  * Data structures related to compilation.
@@ -56,55 +63,54 @@ MODULE_SCOPE 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 {
@@ -114,89 +120,80 @@ 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;		/* 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. */
+  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 */
 } ECL;
 
 typedef struct ExtCmdLoc {
-    int type;			/* Context type. */
-    int start;			/* Starting line for compiled script. Needed
-				 * for the extended recompile check in
-				 * tclCompileObj. */
-    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 */
+  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)  (ClientData clientData);
-typedef void	   (AuxDataFreeProc) (ClientData clientData);
-typedef void	   (AuxDataPrintProc)(ClientData clientData,
-			    Tcl_Obj *appendObj, struct ByteCode *codePtr,
-			    unsigned int pcOffset);
+typedef ClientData (AuxDataDupProc)  _ANSI_ARGS_((ClientData clientData));
+typedef void       (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
 
 /*
  * 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 {
-    const 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. */
+    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. */
 } AuxDataType;
 
 /*
@@ -206,8 +203,8 @@ typedef struct AuxDataType {
  */
 
 typedef struct AuxData {
-    const 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;
 
@@ -225,127 +222,117 @@ 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. */
-    const 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. */
+    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. */
+                                /* Initial storage for aux data array. */
+#ifdef TCL_TIP280
     /* 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
-				 * line counter. */
-    int *clNext;		/* If not NULL, it refers to the next slot in
-				 * clLoc to check for an invisible
-				 * continuation line. */
+    ContLineLoc* clLoc;  /* If not NULL, the table holding the
+			  * locations of the invisible continuation
+			  * lines in the input script, to adjust the
+			  * line counter. */
+    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
-
-#define TCL_BYTECODE_RECOMPILE			0x0004
-
 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. */
@@ -353,25 +340,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 */
-    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. */
+                                 * 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. */
     Proc *procPtr;		/* If the ByteCode was compiled from a
 				 * procedure body, this is a pointer to its
 				 * Proc structure; otherwise NULL. This
@@ -387,72 +374,71 @@ 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. */
-    LocalCache *localCachePtr;	/* Pointer to the start of the cached variable
-				 * names and initialisation data for local
-				 * variables. */
+				/* 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. */
 #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 */
@@ -501,7 +487,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
@@ -578,119 +564,24 @@ 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
-
-/* 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
-
-/*
- * 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
-
-/* For [subst] compilation */
-#define INST_NOP			132
-#define INST_RETURN_CODE_BRANCH		133
-
-/* For [unset] compilation */
-#define INST_UNSET_SCALAR		134
-#define INST_UNSET_ARRAY		135
-#define INST_UNSET_ARRAY_STK		136
-#define INST_UNSET_STK			137
-
-/* For [dict with] compilation */
-#define INST_DICT_EXPAND		138
-#define INST_DICT_RECOMBINE_STK		139
-#define INST_DICT_RECOMBINE_IMM		140
+#define INST_LSET_FLAT                  97
 
 /* The last opcode */
-#define LAST_INST_OPCODE		140
-
+#define LAST_INST_OPCODE        	97
+
 /*
- * 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.
+ * 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
@@ -700,43 +591,94 @@ 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_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. */
+    OPERAND_UINT4		/* Four byte unsigned integer. */
 } InstOperandType;
 
 typedef struct InstructionDesc {
-    const char *name;		/* Name of instruction. */
+    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;
 
-MODULE_SCOPE InstructionDesc const tclInstructionTable[];
+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[];
 
 /*
  * 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 {
@@ -755,14 +697,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. */
@@ -775,21 +717,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;
 
 /*
@@ -801,73 +743,33 @@ 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;
 
-MODULE_SCOPE const 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;
+extern AuxDataType		tclForeachInfoType;
 
-MODULE_SCOPE const 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 const 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.
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE Tcl_NRPostProc	NRCommand;
-MODULE_SCOPE Tcl_ObjCmdProc	NRInterpCoroutine;
+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));
+
 
 /*
  *----------------------------------------------------------------
@@ -875,494 +777,325 @@ MODULE_SCOPE Tcl_ObjCmdProc	NRInterpCoroutine;
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-			    const CmdFrame *invoker, int word);
+#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
 
 /*
  *----------------------------------------------------------------
- * 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:
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
-MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
+EXTERN void		TclCleanupByteCode _ANSI_ARGS_((ByteCode *codePtr));
+EXTERN int		TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, int count,
-			    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,
+			    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,
 			    Tcl_Token *tokenPtr, int numWords,
-			    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,
+			    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,
 			    Tcl_Token *tokenPtr, int count,
-			    CompileEnv *envPtr);
-MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
-			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
-MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
-			    const AuxDataType *typePtr, CompileEnv *envPtr);
-MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
-			    CompileEnv *envPtr);
-MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, int size);
-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	TclNRExecuteByteCode(Tcl_Interp *interp,
-			    ByteCode *codePtr);
-MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
-MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
-			    int create, CompileEnv *envPtr);
-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);
+			    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));
 #ifdef TCL_COMPILE_STATS
-MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
-MODULE_SCOPE int	TclLog2(int value);
+EXTERN char *		TclLiteralStats _ANSI_ARGS_((
+			    LiteralTable *tablePtr));
+EXTERN int		TclLog2 _ANSI_ARGS_((int value));
 #endif
 #ifdef TCL_COMPILE_DEBUG
-MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
+EXTERN void		TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp *interp,
+		            Tcl_Obj *objPtr));
 #endif
-MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
-			    const 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(const 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 void	TclInvalidateCmdLiteral(Tcl_Interp *interp, 
-			    const char *name, Namespace *nsPtr);
-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[]);
+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));
 #ifdef TCL_COMPILE_DEBUG
-MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
-MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
+EXTERN void		TclVerifyGlobalLiteralTable _ANSI_ARGS_((
+			    Interp *iPtr));
+EXTERN void		TclVerifyLocalLiteralTable _ANSI_ARGS_((
+			    CompileEnv *envPtr));
 #endif
-MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
-			    Tcl_Obj *valuePtr);
-MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
-					  const char *script,
-					  const char *command, int length,
-					  const unsigned char *pc, Tcl_Obj **tosPtr); 
-MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
-					    const unsigned char *pc, Tcl_Obj **tosPtr);
-MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
-
-
+EXTERN int		TclCompileVariableCmd _ANSI_ARGS_((
+			    Tcl_Interp *interp, Tcl_Parse *parsePtr, CompileEnv *envPtr));
+
 /*
  *----------------------------------------------------------------
- * Macros and flag values used by Tcl bytecode compilation and execution
- * modules inside the Tcl core but not used outside.
+ * Macros used by Tcl bytecode compilation and execution modules
+ * inside the Tcl core but not used outside.
  *----------------------------------------------------------------
  */
 
-#define LITERAL_ON_HEAP		0x01
-#define LITERAL_CMD_NAME	0x02
-
 /*
- * Form of TclRegisterLiteral with flags == 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);
+ * 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.
  */
 
 #define TclRegisterNewLiteral(envPtr, bytes, length) \
-    TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
-
-/*
- * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. 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 TclRegisterNewCmdLiteral(envPtr, bytes, length) \
-    TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
-
-/*
- * 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) \
-    do {								\
-	if ((delta) < 0) {						\
-	    if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {	\
-		(envPtr)->maxStackDepth = (envPtr)->currStackDepth;	\
-	    }								\
-	}								\
-	(envPtr)->currStackDepth += (delta);				\
-    } while (0)
+	TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 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.
- *
- * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);
+ * 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.
  */
 
 #define TclUpdateStackReqs(op, i, envPtr) \
-    do {							\
-	int delta = tclInstructionTable[(op)].stackEffect;	\
-	if (delta) {						\
-	    if (delta == INT_MIN) {				\
-		delta = 1 - (i);				\
-	    }							\
-	    TclAdjustStackDepth(delta, envPtr);			\
-	}							\
-    } while (0)
+    {\
+	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);\
+		}\
+	    }\
+	    (envPtr)->currStackDepth += delta;\
+	}\
+    }
 
 /*
- * 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:
  *
- * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
+ * EXTERN void	TclEmitOpcode _ANSI_ARGS_((unsigned char op,
+ *		    CompileEnv *envPtr));
  */
 
 #define TclEmitOpcode(op, envPtr) \
-    do {							\
-	if ((envPtr)->codeNext == (envPtr)->codeEnd) {		\
-	    TclExpandCodeArray(envPtr);				\
-	}							\
-	*(envPtr)->codeNext++ = (unsigned char) (op);		\
-	(envPtr)->atCmdStart = ((op) == INST_START_CMD);	\
-	TclUpdateStackReqs(op, 0, envPtr);			\
-    } while (0)
+    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
+        TclExpandCodeArray(envPtr); \
+    *(envPtr)->codeNext++ = (unsigned char) (op);\
+    TclUpdateStackReqs(op, 0, envPtr)
 
 /*
- * Macros to emit an integer operand. The ANSI C "prototype" for these macros
- * are:
+ * Macro to emit an integer operand.
+ * The ANSI C "prototype" for this macro is:
  *
- * void TclEmitInt1(int i, CompileEnv *envPtr);
- * void TclEmitInt4(int i, CompileEnv *envPtr);
+ * EXTERN void	TclEmitInt1 _ANSI_ARGS_((int i, CompileEnv *envPtr));
  */
 
 #define TclEmitInt1(i, envPtr) \
-    do {								\
-	if ((envPtr)->codeNext == (envPtr)->codeEnd) {			\
-	    TclExpandCodeArray(envPtr);					\
-	}								\
-	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
-    } while (0)
-
-#define TclEmitInt4(i, envPtr) \
-    do {								\
-	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)      );		\
-    } while (0)
+    if ((envPtr)->codeNext == (envPtr)->codeEnd) \
+        TclExpandCodeArray(envPtr); \
+    *(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:
  *
- * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
- * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
+ * EXTERN void	TclEmitInstInt1 _ANSI_ARGS_((unsigned char op, int i, 
+ *		    CompileEnv *envPtr));
+ * EXTERN void	TclEmitInstInt4 _ANSI_ARGS_((unsigned char op, int i, 
+ *		    CompileEnv *envPtr));
  */
 
+
 #define TclEmitInstInt1(op, i, envPtr) \
-    do {								\
-	if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) {		\
-	    TclExpandCodeArray(envPtr);					\
-	}								\
-	*(envPtr)->codeNext++ = (unsigned char) (op);			\
-	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
-	(envPtr)->atCmdStart = ((op) == INST_START_CMD);		\
-	TclUpdateStackReqs(op, i, envPtr);				\
-    } while (0)
+    if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
+        TclExpandCodeArray(envPtr); \
+    } \
+    *(envPtr)->codeNext++ = (unsigned char) (op); \
+    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
+    TclUpdateStackReqs(op, i, envPtr)
 
 #define TclEmitInstInt4(op, i, envPtr) \
-    do {							\
-	if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) {	\
-	    TclExpandCodeArray(envPtr);				\
-	}							\
-	*(envPtr)->codeNext++ = (unsigned char) (op);		\
-	*(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)      );	\
-	(envPtr)->atCmdStart = ((op) == INST_START_CMD);	\
-	TclUpdateStackReqs(op, i, envPtr);			\
-    } while (0)
-
+    if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
+        TclExpandCodeArray(envPtr); \
+    } \
+    *(envPtr)->codeNext++ = (unsigned char) (op); \
+    *(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)      );\
+    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:
  *
- * void	TclEmitPush(int objIndex, CompileEnv *envPtr);
+ * EXTERN void	TclEmitPush _ANSI_ARGS_((int objIndex, CompileEnv *envPtr));
  */
 
 #define TclEmitPush(objIndex, envPtr) \
-    do {							 \
-	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)); \
-	}							 \
-    } while (0)
+	}\
+    }
 
 /*
- * 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:
  *
- * void TclStoreInt1AtPtr(int i, unsigned char *p);
- * void TclStoreInt4AtPtr(int i, unsigned char *p);
+ * EXTERN void	TclStoreInt1AtPtr _ANSI_ARGS_((int i, unsigned char *p));
+ * EXTERN void	TclStoreInt4AtPtr _ANSI_ARGS_((int i, unsigned char *p));
  */
-
+    
 #define TclStoreInt1AtPtr(i, p) \
     *(p)   = (unsigned char) ((unsigned int) (i))
-
+    
 #define TclStoreInt4AtPtr(i, p) \
-    do {							\
-	*(p)   = (unsigned char) ((unsigned int) (i) >> 24);	\
-	*(p+1) = (unsigned char) ((unsigned int) (i) >> 16);	\
-	*(p+2) = (unsigned char) ((unsigned int) (i) >>  8);	\
-	*(p+3) = (unsigned char) ((unsigned int) (i)      );	\
-    } while (0)
+    *(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
+    *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
+    *(p+2) = (unsigned char) ((unsigned int) (i) >>  8); \
+    *(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:
  *
- * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
- * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
+ * 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));
  */
 
 #define TclUpdateInstInt1AtPc(op, i, pc) \
-    do {					\
-	*(pc) = (unsigned char) (op);		\
-	TclStoreInt1AtPtr((i), ((pc)+1));	\
-    } while (0)
+    *(pc) = (unsigned char) (op); \
+    TclStoreInt1AtPtr((i), ((pc)+1))
 
 #define TclUpdateInstInt4AtPc(op, i, pc) \
-    do {					\
-	*(pc) = (unsigned char) (op);		\
-	TclStoreInt4AtPtr((i), ((pc)+1));	\
-    } while (0)
-
-/*
- * 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))
-
+    *(pc) = (unsigned char) (op); \
+    TclStoreInt4AtPtr((i), ((pc)+1))
+    
 /*
  * 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:
  *
- * int TclGetInt1AtPtr(unsigned char *p);
- * int TclGetInt4AtPtr(unsigned char *p);
- * unsigned int TclGetUInt1AtPtr(unsigned char *p);
- * unsigned int TclGetUInt4AtPtr(unsigned char *p);
+ * 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));
  */
 
 /*
- * 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__
 #   define TclGetInt1AtPtr(p) ((int) *((char *) p))
-#elif defined(HAVE_SIGNED_CHAR)
-#   define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
 #else
-#   define TclGetInt1AtPtr(p) \
-    (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
+#   ifdef HAVE_SIGNED_CHAR
+#	define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
+#    else
+#	define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
+		| ((*(p) & 0200) ? (-256) : 0))
+#    endif
 #endif
 
-#define TclGetInt4AtPtr(p) \
-    (((int) TclGetInt1AtPtr(p) << 24) |				\
-		     (*((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)))
+#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
+		                  	    (*((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:
- *
- * int TclMin(int i, int j);
- * int TclMax(int i, int j);
- */
-
-#define TclMin(i, j)	((((int) i) < ((int) j))? (i) : (j))
-#define TclMax(i, j)	((((int) i) > ((int) j))? (i) : (j))
+#define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
+#define TclGetUInt4AtPtr(p) ((unsigned int) (*(p)     << 24) | \
+		                            (*((p)+1) << 16) | \
+				            (*((p)+2) <<  8) | \
+				            (*((p)+3)))
 
 /*
- * Convenience macro for use when compiling bodies of commands. The ANSI C
- * "prototype" for this macro is:
+ * Macros used to compute the minimum and maximum of two integers.
+ * The ANSI C "prototypes" for these macros are:
  *
- * static void		CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
- *			    Tcl_Interp *interp);
+ * EXTERN int  TclMin _ANSI_ARGS_((int i, int j));
+ * EXTERN int  TclMax _ANSI_ARGS_((int i, int j));
  */
 
-#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))
-
-/*
- * Check if there is an LVT for compiled locals
- */
-
-#define EnvHasLVT(envPtr) \
-    (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)
+#define TclMin(i, j)   ((((int) i) < ((int) j))? (i) : (j))
+#define TclMax(i, j)   ((((int) i) > ((int) j))? (i) : (j))
 
 /*
  * DTrace probe macros (NOPs if DTrace support is not enabled).
@@ -1376,7 +1109,7 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
  * If the second macro is defined, logging to file starts immediately,
  * otherwise only after the first call to [tcl::dtrace]. Note that the debug
  * probe data is always computed, even when it is not logged to file.
- *
+ * 
  * Defining the third macro enables debug logging of inst probes (disabled
  * by default due to the significant performance impact).
  */
@@ -1391,10 +1124,10 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 
 #ifdef USE_DTRACE
 
+#include "tclDTrace.h"
+
 #if defined(__GNUC__) && __GNUC__ > 2
-/*
- * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks.
- */
+/* Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. */
 #define unlikely(x) (__builtin_expect((x), 0))
 #else
 #define unlikely(x) (x)
@@ -1404,27 +1137,21 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 #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, a6, a7) \
-	TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
 
 #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, a6, a7) \
-	TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
 
 #define TCL_DTRACE_INST_START_ENABLED()	    unlikely(TCL_INST_START_ENABLED())
 #define TCL_DTRACE_INST_DONE_ENABLED()	    unlikely(TCL_INST_DONE_ENABLED())
@@ -1437,32 +1164,25 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 
 #define TCL_DTRACE_DEBUG_LOG()
 
-MODULE_SCOPE void	TclDTraceInfo(Tcl_Obj *info, const 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)   {if (a0) {}}
-#define TCL_DTRACE_PROC_RETURN(a0, a1)	    {if (a0) {}}
-#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}}
+#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, a6, a7) {}
 
 #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, a6, a7) {}
 
 #define TCL_DTRACE_INST_START_ENABLED()	    0
 #define TCL_DTRACE_INST_DONE_ENABLED()	    0
@@ -1472,8 +1192,6 @@ MODULE_SCOPE void	TclDTraceInfo(Tcl_Obj *info, const char **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 */
@@ -1493,42 +1211,32 @@ MODULE_SCOPE void	TclDTraceInfo(Tcl_Obj *info, const char **args,
 MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
 MODULE_SCOPE FILE *tclDTraceDebugLog;
 MODULE_SCOPE void TclDTraceOpenDebugLog(void);
-MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi);
+MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
 
 #define TCL_DTRACE_DEBUG_LOG() \
-    int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;	\
-    int tclDTraceDebugIndent = 0;				\
-    FILE *tclDTraceDebugLog = NULL;				\
-    void TclDTraceOpenDebugLog(void) {				\
-	char n[35];						\
-	sprintf(n, "/tmp/tclDTraceDebug-%lu.log",		\
-		(unsigned long) getpid());			\
-	tclDTraceDebugLog = fopen(n, "a");			\
-    }
-
-#define TclDTraceDbgMsg(p, m, ...) \
-    do {								\
-	if (tclDTraceDebugEnabled) {					\
-	    int _l, _t = 0;						\
-	    if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); }	\
-	    fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n",			\
-		    strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \
-	    fprintf(tclDTraceDebugLog, " %.*s():%n",			\
-		    (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \
-	    fprintf(tclDTraceDebugLog, "%*s" p "%n",			\
-		    (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \
-		    "", &_l); _t += _l;					\
-	    fprintf(tclDTraceDebugLog, "%*s" m "\n",			\
-		    (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__);	\
-	    fflush(tclDTraceDebugLog);					\
-	}								\
-    } while (0)
+	int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;\
+	int tclDTraceDebugIndent = 0; \
+	FILE *tclDTraceDebugLog = NULL; \
+	void TclDTraceOpenDebugLog(void) { char n[35]; \
+	sprintf(n, "/tmp/tclDTraceDebug-%lu.log", (unsigned long) getpid()); \
+	tclDTraceDebugLog = fopen(n, "a"); } \
+
+#define TclDTraceDbgMsg(p, m, ...) do { if (tclDTraceDebugEnabled) { \
+	int _l, _t = 0; if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \
+	fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", strrchr(__FILE__, '/') + \
+		1, __LINE__, &_l); _t += _l; \
+	fprintf(tclDTraceDebugLog, " %.*s():%n", (_t < 18 ? 18 - _t : 0) + \
+		18, __func__, &_l); _t += _l; \
+	fprintf(tclDTraceDebugLog, "%*s" p "%n", (_t < 40 ? 40 - _t : 0) + \
+		2 * tclDTraceDebugIndent, "", &_l); _t += _l; \
+	fprintf(tclDTraceDebugLog, "%*s" m "\n", (_t < 64 ? 64 - _t : 1), "", \
+		##__VA_ARGS__); fflush(tclDTraceDebugLog); \
+	} } while (0)
 
 #define TCL_DTRACE_PROC_ENTRY_ENABLED()	    1
 #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)
@@ -1540,15 +1248,11 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const 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, a6, a7) \
-	TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \
-		a2, a3, a4, a5, a6, a7)
 
 #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)
@@ -1560,9 +1264,6 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const 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, a6, a7) \
-	TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \
-		a2, a3, a4, a5, a6, a7)
 
 #define TCL_DTRACE_INST_START_ENABLED()	    TCL_DTRACE_DEBUG_INST_PROBES
 #define TCL_DTRACE_INST_DONE_ENABLED()	    TCL_DTRACE_DEBUG_INST_PROBES
@@ -1573,20 +1274,13 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi);
 
 #define TCL_DTRACE_TCL_PROBE_ENABLED()	    1
 #define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
-    do {								\
-	tclDTraceDebugEnabled = 1;					\
+	tclDTraceDebugEnabled = 1; \
 	TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \
-		a1, a2, a3, a4, a5, a6, a7, a8, a9);			\
-    } while (0)
+		a1, a2, a3, a4, a5, a6, a7, a8, a9)
 
 #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
deleted file mode 100644
index b4735e8..0000000
--- a/generic/tclConfig.c
+++ /dev/null
@@ -1,397 +0,0 @@
-/*
- * 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. */
-    const Tcl_Config *configuration,	/* Embedded configuration. */
-    const char *valEncoding)	/* Name of the encoding used to store the
-				 * configuration values, ASCII, thus UTF-8. */
-{
-    Tcl_DString cmdName;
-    const Tcl_Config *cfg;
-    Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
-    QCCD *cdPtr = 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) {
-	Tcl_Obj *pkgDict, *pDB = GetConfigDict(interp);
-
-	/*
-	 * Retrieve package specific configuration...
-	 */
-
-	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, 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 = clientData;
-    Tcl_Obj *pkgName = cdPtr->pkg;
-    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
-    int n, index;
-    static const char *const subcmdStrings[] = {
-	"get", "list", NULL
-    };
-    enum subcmds {
-	CFG_GET, CFG_LIST
-    };
-
-    if ((objc < 2) || (objc > 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
-	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);
-	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
-		Tcl_GetString(pkgName), NULL);
-	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);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
-		    Tcl_GetString(objv[2]), NULL);
-	    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);
-	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	    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 = clientData;
-    Tcl_Obj *pkgName = cdPtr->pkg;
-    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);
-
-    Tcl_DictObjRemove(NULL, pDB, pkgName);
-    Tcl_DecrRefCount(pkgName);
-    ckfree(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 = 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 360bdff..1713de5 100644
--- a/generic/tclDTrace.d
+++ b/generic/tclDTrace.d
@@ -3,14 +3,13 @@
  *
  *	Tcl DTrace provider.
  *
- * Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
+ * 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.
  */
 
 typedef struct Tcl_Obj Tcl_Obj;
-typedef const char* TclDTraceStr;
 
 /*
  * Tcl DTrace probes
@@ -25,14 +24,14 @@ provider tcl {
      *		arg1: number of arguments		(int)
      *		arg2: array of proc argument objects	(Tcl_Obj**)
      */
-    probe proc__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
+    probe proc__entry(char* name, int objc, struct Tcl_Obj **objv);
     /*
      *	tcl*:::proc-return probe
      *	    triggered immediately after proc bytecode execution
      *		arg0: proc name				(string)
      *		arg1: return code			(int)
      */
-    probe proc__return(TclDTraceStr name, int code);
+    probe proc__return(char* name, int code);
     /*
      *	tcl*:::proc-result probe
      *	    triggered after proc-return probe and result processing
@@ -41,8 +40,7 @@ provider tcl {
      *		arg2: proc result			(string)
      *		arg3: proc result object		(Tcl_Obj*)
      */
-    probe proc__result(TclDTraceStr name, int code, TclDTraceStr result,
-	    struct Tcl_Obj *resultobj);
+    probe proc__result(char* name, int code, char* result, struct Tcl_Obj *resultobj);
     /*
      *	tcl*:::proc-args probe
      *	    triggered before proc-entry probe, gives access to string
@@ -50,26 +48,9 @@ provider tcl {
      *		arg0: proc name				(string)
      *		arg1-arg9: proc arguments or NULL	(strings)
      */
-    probe proc__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2,
-	    TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
-	    TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
-	    TclDTraceStr 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)
-     *		arg6: TclOO method			(string)
-     *		arg7: TclOO class/object		(string)
-     */
-    probe proc__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
-	    TclDTraceStr file, int line, int level, TclDTraceStr method,
-	    TclDTraceStr class);
+    probe proc__args(char* name, char* arg1, char* arg2, char* arg3,
+	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+	    char* arg9);
 
     /***************************** cmd probes ******************************/
     /*
@@ -79,14 +60,14 @@ provider tcl {
      *		arg1: number of arguments		(int)
      *		arg2: array of command argument objects	(Tcl_Obj**)
      */
-    probe cmd__entry(TclDTraceStr name, int objc, struct Tcl_Obj **objv);
+    probe cmd__entry(char* name, int objc, struct Tcl_Obj **objv);
     /*
      *	tcl*:::cmd-return probe
      *	    triggered immediately after commmand execution
      *		arg0: command name			(string)
      *		arg1: return code			(int)
      */
-    probe cmd__return(TclDTraceStr name, int code);
+    probe cmd__return(char* name, int code);
     /*
      *	tcl*:::cmd-result probe
      *	    triggered after cmd-return probe and result processing
@@ -95,8 +76,7 @@ provider tcl {
      *		arg2: command result			(string)
      *		arg3: command result object		(Tcl_Obj*)
      */
-    probe cmd__result(TclDTraceStr name, int code, TclDTraceStr result,
-	    struct Tcl_Obj *resultobj);
+    probe cmd__result(char* name, int code, char* result, struct Tcl_Obj *resultobj);
     /*
      *	tcl*:::cmd-args probe
      *	    triggered before cmd-entry probe, gives access to string
@@ -104,26 +84,9 @@ provider tcl {
      *		arg0: command name			(string)
      *		arg1-arg9: command arguments or NULL	(strings)
      */
-    probe cmd__args(TclDTraceStr name, TclDTraceStr arg1, TclDTraceStr arg2,
-	    TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
-	    TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
-	    TclDTraceStr 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)
-     *		arg6: TclOO method			(string)
-     *		arg7: TclOO class/object		(string)
-     */
-    probe cmd__info(TclDTraceStr cmd, TclDTraceStr type, TclDTraceStr proc,
-	    TclDTraceStr file, int line, int level, TclDTraceStr method,
-	    TclDTraceStr class);
+    probe cmd__args(char* name, char* arg1, char* arg2, char* arg3,
+	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+	    char* arg9);
 
     /***************************** inst probes *****************************/
     /*
@@ -133,7 +96,7 @@ provider tcl {
      *		arg1: depth of stack			(int)
      *		arg2: top of stack			(Tcl_Obj**)
      */
-    probe inst__start(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
+    probe inst__start(char* name, int depth, struct Tcl_Obj **stack);
     /*
      *	tcl*:::inst-done probe
      *	    triggered immediately after execution of a bytecode
@@ -141,7 +104,7 @@ provider tcl {
      *		arg1: depth of stack			(int)
      *		arg2: top of stack			(Tcl_Obj**)
      */
-    probe inst__done(TclDTraceStr name, int depth, struct Tcl_Obj **stack);
+    probe inst__done(char* name, int depth, struct Tcl_Obj **stack);
 
     /***************************** obj probes ******************************/
     /*
@@ -163,10 +126,9 @@ provider tcl {
      *	    triggered when the ::tcl::dtrace command is called
      *		arg0-arg9: command arguments		(strings)
      */
-    probe tcl__probe(TclDTraceStr arg0, TclDTraceStr arg1, TclDTraceStr arg2,
-	    TclDTraceStr arg3, TclDTraceStr arg4, TclDTraceStr arg5,
-	    TclDTraceStr arg6, TclDTraceStr arg7, TclDTraceStr arg8,
-	    TclDTraceStr arg9);
+    probe tcl__probe(char* arg0, char* arg1, char* arg2, char* arg3,
+	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
+	    char* arg9);
 };
 
 /*
@@ -195,10 +157,6 @@ 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 14bac51..b64a792 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -1,2563 +1,663 @@
-/* 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.
- */
-#include "tclInt.h"
-
-/*
- * Bison generates several labels that happen to be unused. MS Visual C++
- * doesn't like that, and complains. Tell it to shut up.
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
-#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.
- */
+#include "tclInt.h"
+#include "tclPort.h"
 
-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
+#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
+#   define EPOCH           1904
+#   define START_OF_TIME   1904
+#   define END_OF_TIME     2039
+#else
+#   define EPOCH           1970
+#   define START_OF_TIME   1902
+#   define END_OF_TIME     2037
+#endif
 
 /*
  * The offset of tm_year of struct tm returned by localtime, gmtime, etc.
- * Posix requires 1900.
+ * 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.
  */
+#define TM_YEAR_BASE 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 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 {
-    const char *name;
-    int type;
-    time_t value;
+    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;
 
 
-
-/* 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.  */
-
-
+/*
+ *  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;
 
 /*
  * 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));
 
-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
-
-#ifdef YYTYPE_UINT8
-typedef YYTYPE_UINT8 yytype_uint8;
-#else
-typedef unsigned char yytype_uint8;
-#endif
-
-#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
-
-#ifdef YYTYPE_INT16
-typedef YYTYPE_INT16 yytype_int16;
-#else
-typedef short int yytype_int16;
+int
+TclDateparse _ANSI_ARGS_((void));
+typedef union
+#ifdef __cplusplus
+	YYSTYPE
 #endif
-
-#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
+ {
+    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" {
 #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
+#ifndef TclDateerror
+#if defined(__cplusplus)
+	void TclDateerror(CONST char *);
 #endif
-
-/* 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;
+#ifndef TclDatelex
+	int TclDatelex(void);
 #endif
-{
-  return i;
+	int TclDateparse(void);
+#if defined(__cplusplus) && defined(__EXTERN_C__)
 }
 #endif
 
-#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
 
-/* 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
-};
-
-#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
-};
-
-/* 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
-};
-
-/* 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
-};
+#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
 #endif
-
-#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
-};
+#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;
 #endif
+static int TclDatemaxdepth = YYMAXDEPTH;
+# define YYERRCODE 256
 
-# 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
 
-/* 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
-};
-
-/* 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
+/*
+ * 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 }
 };
 
-/* YYPGOTO[NTERM-NUM].  */
-static const yytype_int8 yypgoto[] =
-{
-     -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,
-     -22,   -22,   -22,    -9,   -22,     6
+/*
+ * 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 }
 };
 
-/* 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
+/*
+ * 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 }
 };
 
-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
+/*
+ * 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  }
 };
 
-/* 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
+/*
+ * 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 }
 };
 
-#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
+/*
+ * Dump error messages in the bit bucket.
+ */
 static void
-yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
-    FILE *yyoutput;
-    int yytype;
-    YYSTYPE const * const yyvaluep;
-    YYLTYPE const * const yylocationp;
-    DateInfo* info;
-#endif
+TclDateerror(s)
+    char  *s;
 {
-  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;
-    }
 }
 
 
-/*--------------------------------.
-| 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
+static time_t
+ToSeconds(Hours, Minutes, Seconds, Meridian)
+    time_t      Hours;
+    time_t      Minutes;
+    time_t      Seconds;
+    MERIDIAN    Meridian;
 {
-  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, ")");
+    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 */
 }
 
-/*------------------------------------------------------------------.
-| 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
+/*
+ *-----------------------------------------------------------------------------
+ *
+ * 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;
 {
-  YYFPRINTF (stderr, "Stack now");
-  for (; bottom <= top; ++bottom)
-    YYFPRINTF (stderr, " %d", *bottom);
-  YYFPRINTF (stderr, "\n");
-}
-
-# define YY_STACK_PRINT(Bottom, Top)				\
-do {								\
-  if (yydebug)							\
-    yy_stack_print ((Bottom), (Top));				\
-} while (YYID (0))
+    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;
 
-/*------------------------------------------------.
-| Report that the YYRULE is going to be reduced.  |
-`------------------------------------------------*/
+    /* 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;
 
-#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");
+    /* 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);
     }
-}
-
-# 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
-
-/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
-   if the built-in stack extension method is used).
-
-   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
+    Julian *= SECSPERDAY;
 
-
+    /* Add the timezone offset ?? */
+    Julian += TclDateTimezone * 60L;
 
-#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
-{
-  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;
+    /* Add the number of seconds represented by the time component */
+    if ((tod = ToSeconds(Hours, Minutes, Seconds, Meridian)) < 0)
+        return -1;
+    Julian += tod;
 
-  while ((*yyd++ = *yys++) != '\0')
-    continue;
-
-  return yyd - 1;
+    /* Perform a preliminary DST compensation ?? */
+    if (DSTmode == DSTon
+     || (DSTmode == DSTmaybe && TclpGetDate((TclpTime_t)&Julian, 0)->tm_isdst))
+        Julian -= 60 * 60;
+    *TimePtr = Julian;
+    return 0;
 }
-#  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: ;
-    }
 
-  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)
+static time_t
+DSTcorrect(Start, Future)
+    time_t      Start;
+    time_t      Future;
 {
-  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;
-    }
+    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;
 }
-#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
+static time_t
+NamedDay(Start, DayOrdinal, DayNumber)
+    time_t      Start;
+    time_t      DayOrdinal;
+    time_t      DayNumber;
 {
-  YYUSE (yyvaluep);
-  YYUSE (yylocationp);
-  YYUSE (info);
-
-  if (!yymsg)
-    yymsg = "Deleting";
-  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
-
-  switch (yytype)
-    {
-
-      default:
-	break;
-    }
+    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);
 }
-
-
-/* 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
+static time_t
+NamedMonth(Start, MonthOrdinal, MonthNumber)
+    time_t Start;
+    time_t MonthOrdinal;
+    time_t MonthNumber;
 {
-  /* 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;
-    }
-
-  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.  */
-
-  /* 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;
-    }
-
-  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);
+    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--;
     }
-
-  /* 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;
+    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);
+}
 
-  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;
-    }
-  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
+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);
 
-  yyerror_range[0] = yylloc;
-
-  if (yyerrstatus == 3)
-    {
-      /* If just tried and failed to reuse look-ahead token after an
-	 error, discard it.  */
+    /*
+     * 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 (yychar <= YYEOF)
-	{
-	  /* Return failure if at end of input.  */
-	  if (yychar == YYEOF)
-	    YYABORT;
-	}
-      else
-	{
-	  yydestruct ("Error: discarding",
-		      yytoken, &yylval, &yylloc, info);
-	  yychar = YYEMPTY;
-	}
+    if (TclDateTimezone == 0) {
+        Julian += TclpGetTimeZone((unsigned long) Start) * 60L;
     }
 
-  /* 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;
+    /*
+     * 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).
+     */
 
-      yyerror_range[0] = *yylsp;
-      yydestruct ("Error: popping",
-		  yystos[yystate], yyvsp, yylsp, info);
-      YYPOPSTACK (1);
-      yystate = *yyssp;
-      YY_STACK_PRINT (yyss, yyssp);
+    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 (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);
+    if (result != 0) {
+	return -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);
+    *TimePtr = DSTcorrect(Start, Julian);
+    return 0;
 }
 
 
-
-
-/*
- * 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, 0, 0 }
-};
-
-/*
- * 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, 0, 0 }
-};
-
-/*
- * 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, 0, 0 }
-};
-
-/*
- * 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, 0, 0 }
-};
-
 /*
- * 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, 0, 0 }
-};
-
-/*
- * Dump error messages in the bit bucket.
+ *-----------------------------------------------------------------------------
+ *
+ * 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 void
-TclDateerror(
-    YYLTYPE* location,
-    DateInfo* infoPtr,
-    const char *s)
+static int
+RelativeDay(Start, RelDay, TimePtr)
+    time_t Start;
+    time_t RelDay;
+    time_t *TimePtr;
 {
-    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";
-}
+    time_t new;
 
-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 */
+    new = Start + (RelDay * 60 * 60 * 24);
+    *TimePtr = DSTcorrect(Start, new);
+    return 1;
 }
 
 static int
-LookupWord(
-    YYSTYPE* yylvalPtr,
-    char *buff)
+LookupWord(buff)
+    char                *buff;
 {
     register char *p;
     register char *q;
-    register const TABLE *tp;
-    int i, abbrev;
+    register CONST TABLE *tp;
+    int i;
+    int abbrev;
 
     /*
      * Make it lowercase.
@@ -2566,355 +666,1208 @@ LookupWord(
     Tcl_UtfToLower(buff);
 
     if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
-	yylvalPtr->Meridian = MERam;
-	return tMERIDIAN;
+        TclDatelval.Meridian = MERam;
+        return tMERIDIAN;
     }
     if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
-	yylvalPtr->Meridian = MERpm;
-	return tMERIDIAN;
+        TclDatelval.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) {
-		yylvalPtr->Number = tp->value;
-		return tp->type;
-	    }
-	} else if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        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;
+        }
     }
 
     for (tp = TimezoneTable; tp->name; tp++) {
-	if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        if (strcmp(buff, tp->name) == 0) {
+            TclDatelval.Number = tp->value;
+            return tp->type;
+        }
     }
 
     for (tp = UnitsTable; tp->name; tp++) {
-	if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        if (strcmp(buff, tp->name) == 0) {
+            TclDatelval.Number = tp->value;
+            return tp->type;
+        }
     }
 
     /*
      * Strip off any plural and try the units table again.
      */
-
     i = strlen(buff) - 1;
-    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;
-	    }
+    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;
+            }
 	}
     }
 
     for (tp = OtherTable; tp->name; tp++) {
-	if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        if (strcmp(buff, tp->name) == 0) {
+            TclDatelval.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) {
-		yylvalPtr->Number = tp->value;
-		return tp->type;
-	    }
+	    && 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;
+            }
 	}
     }
 
     /*
      * 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) {
-		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;
+            }
 	}
     }
-
+    
     return tID;
 }
 
+
 static int
-TclDatelex(
-    YYSTYPE* yylvalPtr,
-    YYLTYPE* location,
-    DateInfo *info)
+TclDatelex()
 {
-    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(*TclDateInput))) {
+            TclDateInput++;
 	}
 
-	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
-	    /*
-	     * Convert the string into a number; count the number of digits.
-	     */
-
+        if (isdigit(UCHAR(c = *TclDateInput))) { /* INTL: digit */
+	    /* convert the string into a number; count the number of digits */
 	    Count = 0;
-	    for (yylvalPtr->Number = 0;
-		    isdigit(UCHAR(c = *yyInput++)); ) {	  /* INTL: digit */
-		yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
+            for (TclDatelval.Number = 0;
+		    isdigit(UCHAR(c = *TclDateInput++)); ) { /* INTL: digit */
+                TclDatelval.Number = 10 * TclDatelval.Number + c - '0';
 		Count++;
 	    }
-	    yyInput--;
-	    yyDigitCount = Count;
-
-	    /*
-	     * A number with 6 or more digits is considered an ISO 8601 base.
-	     */
-
+            TclDateInput--;
+	    /* 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 = *TclDateInput++)) /* INTL: ISO only. */
 		     || c == '.'; ) {
-		if (p < &buff[sizeof buff - 1]) {
-		    *p++ = c;
+                if (p < &buff[sizeof buff - 1]) {
+                    *p++ = c;
 		}
 	    }
-	    *p = '\0';
-	    yyInput--;
-	    location->last_column = yyInput - info->dateStart - 1;
-	    return LookupWord(yylvalPtr, buff);
+            *p = '\0';
+            TclDateInput--;
+            return LookupWord(buff);
+        }
+        if (c != '(') {
+            return *TclDateInput++;
 	}
-	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;
+        Count = 0;
+        do {
+            c = *TclDateInput++;
+            if (c == '\0') {
+                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
-TclClockOldscanObjCmd(
-    ClientData clientData,	/* Unused */
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    int objc,			/* Count of paraneters */
-    Tcl_Obj *const *objv)	/* Parameters */
+TclGetDate(p, now, zone, timePtr)
+    char *p;
+    Tcl_WideInt now;
+    long zone;
+    Tcl_WideInt *timePtr;
 {
-    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;
+    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;
     }
-
-    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;
+    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;
     }
-    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);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
-	return TCL_ERROR;
-    } else if (status == 2) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
-	Tcl_DecrRefCount(dateInfo.messages);
-	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	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);
-	Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
-	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;
+	}
     }
-    Tcl_DecrRefCount(dateInfo.messages);
 
-    if (yyHaveDate > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one date in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
-    }
-    if (yyHaveTime > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one time of day in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
-    }
-    if (yyHaveZone > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one time zone in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
+    Start += TclDateRelSeconds;
+    if (RelativeMonth(Start, TclDateRelMonth, &Time) < 0) {
+        return -1;
     }
-    if (yyHaveDay > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one weekday in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
+    Start += Time;
+
+    if (RelativeDay(Start, TclDateRelDay, &Time) < 0) {
+	return -1;
     }
-    if (yyHaveOrdinalMonth > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one ordinal month in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
+    Start += Time;
+    
+    if (TclDateHaveDay && !TclDateHaveDate) {
+        tod = NamedDay(Start, TclDateDayOrdinal, TclDateDayNumber);
+        Start += tod;
     }
 
-    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));
+    if (TclDateHaveOrdinalMonth) {
+	tod = NamedMonth(Start, TclDateMonthOrdinal, TclDateMonth);
+	Start += tod;
     }
-    Tcl_ListObjAppendElement(interp, result, resultElement);
+    
+    *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 (yyHaveTime) {
-	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
-		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
-    } else {
-	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
-    }
+#if YYDEBUG
 
-    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);
+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 */
+};
 
-    Tcl_SetObjResult(interp, result);
-    return TCL_OK;
-}
-
+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 */
 /*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
+ * 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 */
+
+
+
+#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;
+	}
+}
+#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 */
+}
+
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 75dbd9a..c3b2d55 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -12,17 +12,6 @@
 #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
@@ -36,3764 +25,4355 @@
  */
 
 /* 0 */
-EXTERN int		Tcl_PkgProvideEx(Tcl_Interp *interp,
-				const char *name, const char *version,
-				const void *clientData);
+EXTERN int		Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, CONST char *version,
+				ClientData clientData));
 /* 1 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
-				const char *name, const char *version,
-				int exact, void *clientDataPtr);
+EXTERN CONST84_RETURN char * Tcl_PkgRequireEx _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *name,
+				CONST char *version, int exact,
+				ClientData *clientDataPtr));
 /* 2 */
-EXTERN void		Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
+EXTERN void		Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
 /* 3 */
-EXTERN char *		Tcl_Alloc(unsigned int size);
+EXTERN char *		Tcl_Alloc _ANSI_ARGS_((unsigned int size));
 /* 4 */
-EXTERN void		Tcl_Free(char *ptr);
+EXTERN void		Tcl_Free _ANSI_ARGS_((char *ptr));
 /* 5 */
-EXTERN char *		Tcl_Realloc(char *ptr, unsigned int size);
+EXTERN char *		Tcl_Realloc _ANSI_ARGS_((char *ptr,
+				unsigned int size));
 /* 6 */
-EXTERN char *		Tcl_DbCkalloc(unsigned int size, const char *file,
-				int line);
+EXTERN char *		Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
+				CONST char *file, int line));
 /* 7 */
-EXTERN void		Tcl_DbCkfree(char *ptr, const char *file, int line);
+EXTERN int		Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
+				CONST char *file, int line));
 /* 8 */
-EXTERN char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
-				const char *file, int line);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+EXTERN char *		Tcl_DbCkrealloc _ANSI_ARGS_((char *ptr,
+				unsigned int size, CONST char *file,
+				int line));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 9 */
-EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
-				Tcl_FileProc *proc, ClientData clientData);
+EXTERN void		Tcl_CreateFileHandler _ANSI_ARGS_((int fd, int mask,
+				Tcl_FileProc *proc, ClientData clientData));
 #endif /* UNIX */
-#ifdef MAC_OSX_TCL /* MACOSX */
-/* 9 */
-EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
-				Tcl_FileProc *proc, ClientData clientData);
-#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 10 */
-EXTERN void		Tcl_DeleteFileHandler(int fd);
+EXTERN void		Tcl_DeleteFileHandler _ANSI_ARGS_((int fd));
 #endif /* UNIX */
-#ifdef MAC_OSX_TCL /* MACOSX */
-/* 10 */
-EXTERN void		Tcl_DeleteFileHandler(int fd);
-#endif /* MACOSX */
 /* 11 */
-EXTERN void		Tcl_SetTimer(const Tcl_Time *timePtr);
+EXTERN void		Tcl_SetTimer _ANSI_ARGS_((Tcl_Time *timePtr));
 /* 12 */
-EXTERN void		Tcl_Sleep(int ms);
+EXTERN void		Tcl_Sleep _ANSI_ARGS_((int ms));
 /* 13 */
-EXTERN int		Tcl_WaitForEvent(const Tcl_Time *timePtr);
+EXTERN int		Tcl_WaitForEvent _ANSI_ARGS_((Tcl_Time *timePtr));
 /* 14 */
-EXTERN int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
-				Tcl_Obj *objPtr);
+EXTERN int		Tcl_AppendAllObjTypes _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *objPtr));
 /* 15 */
-EXTERN void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
+EXTERN void		Tcl_AppendStringsToObj _ANSI_ARGS_(TCL_VARARGS(Tcl_Obj *,objPtr));
 /* 16 */
-EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
-				int length);
+EXTERN void		Tcl_AppendToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST char *bytes, int length));
 /* 17 */
-EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
+EXTERN Tcl_Obj *	Tcl_ConcatObj _ANSI_ARGS_((int objc,
+				Tcl_Obj *CONST objv[]));
 /* 18 */
-EXTERN int		Tcl_ConvertToType(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
+EXTERN int		Tcl_ConvertToType _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Tcl_ObjType *typePtr));
 /* 19 */
-EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
-				int line);
+EXTERN void		Tcl_DbDecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST char *file, int line));
 /* 20 */
-EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
-				int line);
+EXTERN void		Tcl_DbIncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST char *file, int line));
 /* 21 */
-EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
-				int line);
+EXTERN int		Tcl_DbIsShared _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST char *file, int line));
 /* 22 */
-EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj(int boolValue, const char *file,
-				int line);
+EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj _ANSI_ARGS_((int boolValue,
+				CONST char *file, int line));
 /* 23 */
-EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
-				int length, const char *file, int line);
+EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj _ANSI_ARGS_((
+				CONST unsigned char *bytes, int length,
+				CONST char *file, int line));
 /* 24 */
-EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
-				const char *file, int line);
+EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj _ANSI_ARGS_((double doubleValue,
+				CONST char *file, int line));
 /* 25 */
-EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
-				const char *file, int line);
+EXTERN Tcl_Obj *	Tcl_DbNewListObj _ANSI_ARGS_((int objc,
+				Tcl_Obj *CONST *objv, CONST char *file,
+				int line));
 /* 26 */
-EXTERN Tcl_Obj *	Tcl_DbNewLongObj(long longValue, const char *file,
-				int line);
+EXTERN Tcl_Obj *	Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
+				CONST char *file, int line));
 /* 27 */
-EXTERN Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
+EXTERN Tcl_Obj *	Tcl_DbNewObj _ANSI_ARGS_((CONST char *file, int line));
 /* 28 */
-EXTERN Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, int length,
-				const char *file, int line);
+EXTERN Tcl_Obj *	Tcl_DbNewStringObj _ANSI_ARGS_((CONST char *bytes,
+				int length, CONST char *file, int line));
 /* 29 */
-EXTERN Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
+EXTERN Tcl_Obj *	Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj *objPtr));
 /* 30 */
-EXTERN void		TclFreeObj(Tcl_Obj *objPtr);
+EXTERN void		TclFreeObj _ANSI_ARGS_((Tcl_Obj *objPtr));
 /* 31 */
-EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
-				int *boolPtr);
+EXTERN int		Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *src, int *boolPtr));
 /* 32 */
-EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int *boolPtr);
+EXTERN int		Tcl_GetBooleanFromObj _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *objPtr,
+				int *boolPtr));
 /* 33 */
-EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
-				int *lengthPtr);
+EXTERN unsigned char *	Tcl_GetByteArrayFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int *lengthPtr));
 /* 34 */
-EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
-				double *doublePtr);
+EXTERN int		Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *src, double *doublePtr));
 /* 35 */
-EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, double *doublePtr);
+EXTERN int		Tcl_GetDoubleFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, double *doublePtr));
 /* 36 */
-EXTERN int		Tcl_GetIndexFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr,
-				CONST84 char *const *tablePtr,
-				const char *msg, int flags, int *indexPtr);
+EXTERN int		Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, CONST84 char **tablePtr,
+				CONST char *msg, int flags, int *indexPtr));
 /* 37 */
-EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
-				int *intPtr);
+EXTERN int		Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *src, int *intPtr));
 /* 38 */
-EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int *intPtr);
+EXTERN int		Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int *intPtr));
 /* 39 */
-EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, long *longPtr);
+EXTERN int		Tcl_GetLongFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, long *longPtr));
 /* 40 */
-EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName);
+EXTERN Tcl_ObjType *	Tcl_GetObjType _ANSI_ARGS_((CONST char *typeName));
 /* 41 */
-EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
+EXTERN char *		Tcl_GetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int *lengthPtr));
 /* 42 */
-EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
+EXTERN void		Tcl_InvalidateStringRep _ANSI_ARGS_((Tcl_Obj *objPtr));
 /* 43 */
-EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
-				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
+EXTERN int		Tcl_ListObjAppendList _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *listPtr,
+				Tcl_Obj *elemListPtr));
 /* 44 */
-EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
-				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
+EXTERN int		Tcl_ListObjAppendElement _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *listPtr,
+				Tcl_Obj *objPtr));
 /* 45 */
-EXTERN int		Tcl_ListObjGetElements(Tcl_Interp *interp,
-				Tcl_Obj *listPtr, int *objcPtr,
-				Tcl_Obj ***objvPtr);
+EXTERN int		Tcl_ListObjGetElements _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *listPtr,
+				int *objcPtr, Tcl_Obj ***objvPtr));
 /* 46 */
-EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
+EXTERN int		Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int index,
-				Tcl_Obj **objPtrPtr);
+				Tcl_Obj **objPtrPtr));
 /* 47 */
-EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
-				Tcl_Obj *listPtr, int *lengthPtr);
+EXTERN int		Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *listPtr, int *lengthPtr));
 /* 48 */
-EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
+EXTERN int		Tcl_ListObjReplace _ANSI_ARGS_((Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int first, int count,
-				int objc, Tcl_Obj *const objv[]);
+				int objc, Tcl_Obj *CONST objv[]));
 /* 49 */
-EXTERN Tcl_Obj *	Tcl_NewBooleanObj(int boolValue);
+EXTERN Tcl_Obj *	Tcl_NewBooleanObj _ANSI_ARGS_((int boolValue));
 /* 50 */
-EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
-				int length);
+EXTERN Tcl_Obj *	Tcl_NewByteArrayObj _ANSI_ARGS_((
+				CONST unsigned char *bytes, int length));
 /* 51 */
-EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
+EXTERN Tcl_Obj *	Tcl_NewDoubleObj _ANSI_ARGS_((double doubleValue));
 /* 52 */
-EXTERN Tcl_Obj *	Tcl_NewIntObj(int intValue);
+EXTERN Tcl_Obj *	Tcl_NewIntObj _ANSI_ARGS_((int intValue));
 /* 53 */
-EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
+EXTERN Tcl_Obj *	Tcl_NewListObj _ANSI_ARGS_((int objc,
+				Tcl_Obj *CONST objv[]));
 /* 54 */
-EXTERN Tcl_Obj *	Tcl_NewLongObj(long longValue);
+EXTERN Tcl_Obj *	Tcl_NewLongObj _ANSI_ARGS_((long longValue));
 /* 55 */
-EXTERN Tcl_Obj *	Tcl_NewObj(void);
+EXTERN Tcl_Obj *	Tcl_NewObj _ANSI_ARGS_((void));
 /* 56 */
-EXTERN Tcl_Obj *	Tcl_NewStringObj(const char *bytes, int length);
+EXTERN Tcl_Obj *	Tcl_NewStringObj _ANSI_ARGS_((CONST char *bytes,
+				int length));
 /* 57 */
-EXTERN void		Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
+EXTERN void		Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int boolValue));
 /* 58 */
-EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
+EXTERN unsigned char *	Tcl_SetByteArrayLength _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int length));
 /* 59 */
-EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
-				const unsigned char *bytes, int length);
+EXTERN void		Tcl_SetByteArrayObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST unsigned char *bytes, int length));
 /* 60 */
-EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
+EXTERN void		Tcl_SetDoubleObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				double doubleValue));
 /* 61 */
-EXTERN void		Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
+EXTERN void		Tcl_SetIntObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int intValue));
 /* 62 */
-EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
-				Tcl_Obj *const objv[]);
+EXTERN void		Tcl_SetListObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int objc, Tcl_Obj *CONST objv[]));
 /* 63 */
-EXTERN void		Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
+EXTERN void		Tcl_SetLongObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				long longValue));
 /* 64 */
-EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
+EXTERN void		Tcl_SetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int length));
 /* 65 */
-EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
-				int length);
+EXTERN void		Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST char *bytes, int length));
 /* 66 */
-EXTERN void		Tcl_AddErrorInfo(Tcl_Interp *interp,
-				const char *message);
+EXTERN void		Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *message));
 /* 67 */
-EXTERN void		Tcl_AddObjErrorInfo(Tcl_Interp *interp,
-				const char *message, int length);
+EXTERN void		Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *message, int length));
 /* 68 */
-EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
+EXTERN void		Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
 /* 69 */
-EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
-				const char *element);
+EXTERN void		Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *element));
 /* 70 */
-EXTERN void		Tcl_AppendResult(Tcl_Interp *interp, ...);
+EXTERN void		Tcl_AppendResult _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
 /* 71 */
-EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
-				ClientData clientData);
+EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc *proc,
+				ClientData clientData));
 /* 72 */
-EXTERN void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
+EXTERN void		Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
 /* 73 */
-EXTERN int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
+EXTERN int		Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+				int code));
 /* 74 */
-EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
+EXTERN void		Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
 /* 75 */
-EXTERN int		Tcl_AsyncReady(void);
+EXTERN int		Tcl_AsyncReady _ANSI_ARGS_((void));
 /* 76 */
-EXTERN void		Tcl_BackgroundError(Tcl_Interp *interp);
+EXTERN void		Tcl_BackgroundError _ANSI_ARGS_((Tcl_Interp *interp));
 /* 77 */
-EXTERN char		Tcl_Backslash(const char *src, int *readPtr);
+EXTERN char		Tcl_Backslash _ANSI_ARGS_((CONST char *src,
+				int *readPtr));
 /* 78 */
-EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
-				const char *optionName,
-				const char *optionList);
+EXTERN int		Tcl_BadChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *optionName,
+				CONST char *optionList));
 /* 79 */
-EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
+EXTERN void		Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp *interp,
 				Tcl_InterpDeleteProc *proc,
-				ClientData clientData);
+				ClientData clientData));
 /* 80 */
-EXTERN void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
-				ClientData clientData);
+EXTERN void		Tcl_CancelIdleCall _ANSI_ARGS_((
+				Tcl_IdleProc *idleProc,
+				ClientData clientData));
 /* 81 */
-EXTERN int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
+EXTERN int		Tcl_Close _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan));
 /* 82 */
-EXTERN int		Tcl_CommandComplete(const char *cmd);
+EXTERN int		Tcl_CommandComplete _ANSI_ARGS_((CONST char *cmd));
 /* 83 */
-EXTERN char *		Tcl_Concat(int argc, CONST84 char *const *argv);
+EXTERN char *		Tcl_Concat _ANSI_ARGS_((int argc,
+				CONST84 char *CONST *argv));
 /* 84 */
-EXTERN int		Tcl_ConvertElement(const char *src, char *dst,
-				int flags);
+EXTERN int		Tcl_ConvertElement _ANSI_ARGS_((CONST char *src,
+				char *dst, int flags));
 /* 85 */
-EXTERN int		Tcl_ConvertCountedElement(const char *src,
-				int length, char *dst, int flags);
+EXTERN int		Tcl_ConvertCountedElement _ANSI_ARGS_((
+				CONST char *src, int length, char *dst,
+				int flags));
 /* 86 */
-EXTERN int		Tcl_CreateAlias(Tcl_Interp *slave,
-				const char *slaveCmd, Tcl_Interp *target,
-				const char *targetCmd, int argc,
-				CONST84 char *const *argv);
+EXTERN int		Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp *slave,
+				CONST char *slaveCmd, Tcl_Interp *target,
+				CONST char *targetCmd, int argc,
+				CONST84 char *CONST *argv));
 /* 87 */
-EXTERN int		Tcl_CreateAliasObj(Tcl_Interp *slave,
-				const char *slaveCmd, Tcl_Interp *target,
-				const char *targetCmd, int objc,
-				Tcl_Obj *const objv[]);
+EXTERN int		Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp *slave,
+				CONST char *slaveCmd, Tcl_Interp *target,
+				CONST char *targetCmd, int objc,
+				Tcl_Obj *CONST objv[]));
 /* 88 */
-EXTERN Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
-				const char *chanName,
-				ClientData instanceData, int mask);
+EXTERN Tcl_Channel	Tcl_CreateChannel _ANSI_ARGS_((
+				Tcl_ChannelType *typePtr,
+				CONST char *chanName,
+				ClientData instanceData, int mask));
 /* 89 */
-EXTERN void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
-				Tcl_ChannelProc *proc, ClientData clientData);
+EXTERN void		Tcl_CreateChannelHandler _ANSI_ARGS_((
+				Tcl_Channel chan, int mask,
+				Tcl_ChannelProc *proc, ClientData clientData));
 /* 90 */
-EXTERN void		Tcl_CreateCloseHandler(Tcl_Channel chan,
-				Tcl_CloseProc *proc, ClientData clientData);
+EXTERN void		Tcl_CreateCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
+				Tcl_CloseProc *proc, ClientData clientData));
 /* 91 */
-EXTERN Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
-				const char *cmdName, Tcl_CmdProc *proc,
+EXTERN Tcl_Command	Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *cmdName, Tcl_CmdProc *proc,
 				ClientData clientData,
-				Tcl_CmdDeleteProc *deleteProc);
+				Tcl_CmdDeleteProc *deleteProc));
 /* 92 */
-EXTERN void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
+EXTERN void		Tcl_CreateEventSource _ANSI_ARGS_((
+				Tcl_EventSetupProc *setupProc,
 				Tcl_EventCheckProc *checkProc,
-				ClientData clientData);
+				ClientData clientData));
 /* 93 */
-EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
-				ClientData clientData);
+EXTERN void		Tcl_CreateExitHandler _ANSI_ARGS_((
+				Tcl_ExitProc *proc, ClientData clientData));
 /* 94 */
-EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
+EXTERN Tcl_Interp *	Tcl_CreateInterp _ANSI_ARGS_((void));
 /* 95 */
-EXTERN void		Tcl_CreateMathFunc(Tcl_Interp *interp,
-				const char *name, int numArgs,
+EXTERN void		Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, int numArgs,
 				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
-				ClientData clientData);
+				ClientData clientData));
 /* 96 */
-EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
-				const char *cmdName, Tcl_ObjCmdProc *proc,
+EXTERN Tcl_Command	Tcl_CreateObjCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *cmdName, Tcl_ObjCmdProc *proc,
 				ClientData clientData,
-				Tcl_CmdDeleteProc *deleteProc);
+				Tcl_CmdDeleteProc *deleteProc));
 /* 97 */
-EXTERN Tcl_Interp *	Tcl_CreateSlave(Tcl_Interp *interp,
-				const char *slaveName, int isSafe);
+EXTERN Tcl_Interp *	Tcl_CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *slaveName, int isSafe));
 /* 98 */
-EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
-				Tcl_TimerProc *proc, ClientData clientData);
+EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler _ANSI_ARGS_((int milliseconds,
+				Tcl_TimerProc *proc, ClientData clientData));
 /* 99 */
-EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
-				Tcl_CmdTraceProc *proc,
-				ClientData clientData);
+EXTERN Tcl_Trace	Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
+				int level, Tcl_CmdTraceProc *proc,
+				ClientData clientData));
 /* 100 */
-EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
-				const char *name);
+EXTERN void		Tcl_DeleteAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name));
 /* 101 */
-EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
-				Tcl_ChannelProc *proc, ClientData clientData);
+EXTERN void		Tcl_DeleteChannelHandler _ANSI_ARGS_((
+				Tcl_Channel chan, Tcl_ChannelProc *proc,
+				ClientData clientData));
 /* 102 */
-EXTERN void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
-				Tcl_CloseProc *proc, ClientData clientData);
+EXTERN void		Tcl_DeleteCloseHandler _ANSI_ARGS_((Tcl_Channel chan,
+				Tcl_CloseProc *proc, ClientData clientData));
 /* 103 */
-EXTERN int		Tcl_DeleteCommand(Tcl_Interp *interp,
-				const char *cmdName);
+EXTERN int		Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *cmdName));
 /* 104 */
-EXTERN int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
-				Tcl_Command command);
+EXTERN int		Tcl_DeleteCommandFromToken _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Command command));
 /* 105 */
-EXTERN void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
-				ClientData clientData);
+EXTERN void		Tcl_DeleteEvents _ANSI_ARGS_((
+				Tcl_EventDeleteProc *proc,
+				ClientData clientData));
 /* 106 */
-EXTERN void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
+EXTERN void		Tcl_DeleteEventSource _ANSI_ARGS_((
+				Tcl_EventSetupProc *setupProc,
 				Tcl_EventCheckProc *checkProc,
-				ClientData clientData);
+				ClientData clientData));
 /* 107 */
-EXTERN void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
-				ClientData clientData);
+EXTERN void		Tcl_DeleteExitHandler _ANSI_ARGS_((
+				Tcl_ExitProc *proc, ClientData clientData));
 /* 108 */
-EXTERN void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
+EXTERN void		Tcl_DeleteHashEntry _ANSI_ARGS_((
+				Tcl_HashEntry *entryPtr));
 /* 109 */
-EXTERN void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
+EXTERN void		Tcl_DeleteHashTable _ANSI_ARGS_((
+				Tcl_HashTable *tablePtr));
 /* 110 */
-EXTERN void		Tcl_DeleteInterp(Tcl_Interp *interp);
+EXTERN void		Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 111 */
-EXTERN void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
+EXTERN void		Tcl_DetachPids _ANSI_ARGS_((int numPids,
+				Tcl_Pid *pidPtr));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 111 */
+EXTERN void		Tcl_DetachPids _ANSI_ARGS_((int numPids,
+				Tcl_Pid *pidPtr));
+#endif /* __WIN32__ */
 /* 112 */
-EXTERN void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
+EXTERN void		Tcl_DeleteTimerHandler _ANSI_ARGS_((
+				Tcl_TimerToken token));
 /* 113 */
-EXTERN void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
+EXTERN void		Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Trace trace));
 /* 114 */
-EXTERN void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
+EXTERN void		Tcl_DontCallWhenDeleted _ANSI_ARGS_((
+				Tcl_Interp *interp,
 				Tcl_InterpDeleteProc *proc,
-				ClientData clientData);
+				ClientData clientData));
 /* 115 */
-EXTERN int		Tcl_DoOneEvent(int flags);
+EXTERN int		Tcl_DoOneEvent _ANSI_ARGS_((int flags));
 /* 116 */
-EXTERN void		Tcl_DoWhenIdle(Tcl_IdleProc *proc,
-				ClientData clientData);
+EXTERN void		Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc *proc,
+				ClientData clientData));
 /* 117 */
-EXTERN char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
-				const char *bytes, int length);
+EXTERN char *		Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString *dsPtr,
+				CONST char *bytes, int length));
 /* 118 */
-EXTERN char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
-				const char *element);
+EXTERN char *		Tcl_DStringAppendElement _ANSI_ARGS_((
+				Tcl_DString *dsPtr, CONST char *element));
 /* 119 */
-EXTERN void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
+EXTERN void		Tcl_DStringEndSublist _ANSI_ARGS_((
+				Tcl_DString *dsPtr));
 /* 120 */
-EXTERN void		Tcl_DStringFree(Tcl_DString *dsPtr);
+EXTERN void		Tcl_DStringFree _ANSI_ARGS_((Tcl_DString *dsPtr));
 /* 121 */
-EXTERN void		Tcl_DStringGetResult(Tcl_Interp *interp,
-				Tcl_DString *dsPtr);
+EXTERN void		Tcl_DStringGetResult _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_DString *dsPtr));
 /* 122 */
-EXTERN void		Tcl_DStringInit(Tcl_DString *dsPtr);
+EXTERN void		Tcl_DStringInit _ANSI_ARGS_((Tcl_DString *dsPtr));
 /* 123 */
-EXTERN void		Tcl_DStringResult(Tcl_Interp *interp,
-				Tcl_DString *dsPtr);
+EXTERN void		Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_DString *dsPtr));
 /* 124 */
-EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);
+EXTERN void		Tcl_DStringSetLength _ANSI_ARGS_((Tcl_DString *dsPtr,
+				int length));
 /* 125 */
-EXTERN void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
+EXTERN void		Tcl_DStringStartSublist _ANSI_ARGS_((
+				Tcl_DString *dsPtr));
 /* 126 */
-EXTERN int		Tcl_Eof(Tcl_Channel chan);
+EXTERN int		Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
 /* 127 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
+EXTERN CONST84_RETURN char * Tcl_ErrnoId _ANSI_ARGS_((void));
 /* 128 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
+EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
 /* 129 */
-EXTERN int		Tcl_Eval(Tcl_Interp *interp, const char *script);
+EXTERN int		Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *script));
 /* 130 */
-EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
-				const char *fileName);
+EXTERN int		Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *fileName));
 /* 131 */
-EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+EXTERN int		Tcl_EvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr));
 /* 132 */
-EXTERN void		Tcl_EventuallyFree(ClientData clientData,
-				Tcl_FreeProc *freeProc);
+EXTERN void		Tcl_EventuallyFree _ANSI_ARGS_((
+				ClientData clientData,
+				Tcl_FreeProc *freeProc));
 /* 133 */
-EXTERN void		Tcl_Exit(int status);
+EXTERN void		Tcl_Exit _ANSI_ARGS_((int status));
 /* 134 */
-EXTERN int		Tcl_ExposeCommand(Tcl_Interp *interp,
-				const char *hiddenCmdToken,
-				const char *cmdName);
+EXTERN int		Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *hiddenCmdToken,
+				CONST char *cmdName));
 /* 135 */
-EXTERN int		Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr,
-				int *ptr);
+EXTERN int		Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *expr, int *ptr));
 /* 136 */
-EXTERN int		Tcl_ExprBooleanObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int *ptr);
+EXTERN int		Tcl_ExprBooleanObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int *ptr));
 /* 137 */
-EXTERN int		Tcl_ExprDouble(Tcl_Interp *interp, const char *expr,
-				double *ptr);
+EXTERN int		Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *expr, double *ptr));
 /* 138 */
-EXTERN int		Tcl_ExprDoubleObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, double *ptr);
+EXTERN int		Tcl_ExprDoubleObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, double *ptr));
 /* 139 */
-EXTERN int		Tcl_ExprLong(Tcl_Interp *interp, const char *expr,
-				long *ptr);
+EXTERN int		Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *expr, long *ptr));
 /* 140 */
-EXTERN int		Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				long *ptr);
+EXTERN int		Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, long *ptr));
 /* 141 */
-EXTERN int		Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				Tcl_Obj **resultPtrPtr);
+EXTERN int		Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr));
 /* 142 */
-EXTERN int		Tcl_ExprString(Tcl_Interp *interp, const char *expr);
+EXTERN int		Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *expr));
 /* 143 */
-EXTERN void		Tcl_Finalize(void);
+EXTERN void		Tcl_Finalize _ANSI_ARGS_((void));
 /* 144 */
-EXTERN void		Tcl_FindExecutable(const char *argv0);
+EXTERN void		Tcl_FindExecutable _ANSI_ARGS_((CONST char *argv0));
 /* 145 */
-EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
-				Tcl_HashSearch *searchPtr);
+EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry _ANSI_ARGS_((
+				Tcl_HashTable *tablePtr,
+				Tcl_HashSearch *searchPtr));
 /* 146 */
-EXTERN int		Tcl_Flush(Tcl_Channel chan);
+EXTERN int		Tcl_Flush _ANSI_ARGS_((Tcl_Channel chan));
 /* 147 */
-EXTERN void		Tcl_FreeResult(Tcl_Interp *interp);
+EXTERN void		Tcl_FreeResult _ANSI_ARGS_((Tcl_Interp *interp));
 /* 148 */
-EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
-				const char *slaveCmd,
+EXTERN int		Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *slaveCmd,
 				Tcl_Interp **targetInterpPtr,
 				CONST84 char **targetCmdPtr, int *argcPtr,
-				CONST84 char ***argvPtr);
+				CONST84 char ***argvPtr));
 /* 149 */
-EXTERN int		Tcl_GetAliasObj(Tcl_Interp *interp,
-				const char *slaveCmd,
+EXTERN int		Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *slaveCmd,
 				Tcl_Interp **targetInterpPtr,
 				CONST84 char **targetCmdPtr, int *objcPtr,
-				Tcl_Obj ***objv);
+				Tcl_Obj ***objv));
 /* 150 */
-EXTERN ClientData	Tcl_GetAssocData(Tcl_Interp *interp,
-				const char *name,
-				Tcl_InterpDeleteProc **procPtr);
+EXTERN ClientData	Tcl_GetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name,
+				Tcl_InterpDeleteProc **procPtr));
 /* 151 */
-EXTERN Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
-				const char *chanName, int *modePtr);
+EXTERN Tcl_Channel	Tcl_GetChannel _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *chanName, int *modePtr));
 /* 152 */
-EXTERN int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
+EXTERN int		Tcl_GetChannelBufferSize _ANSI_ARGS_((
+				Tcl_Channel chan));
 /* 153 */
-EXTERN int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
-				ClientData *handlePtr);
+EXTERN int		Tcl_GetChannelHandle _ANSI_ARGS_((Tcl_Channel chan,
+				int direction, ClientData *handlePtr));
 /* 154 */
-EXTERN ClientData	Tcl_GetChannelInstanceData(Tcl_Channel chan);
+EXTERN ClientData	Tcl_GetChannelInstanceData _ANSI_ARGS_((
+				Tcl_Channel chan));
 /* 155 */
-EXTERN int		Tcl_GetChannelMode(Tcl_Channel chan);
+EXTERN int		Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
 /* 156 */
-EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
+EXTERN CONST84_RETURN char * Tcl_GetChannelName _ANSI_ARGS_((
+				Tcl_Channel chan));
 /* 157 */
-EXTERN int		Tcl_GetChannelOption(Tcl_Interp *interp,
-				Tcl_Channel chan, const char *optionName,
-				Tcl_DString *dsPtr);
+EXTERN int		Tcl_GetChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan, CONST char *optionName,
+				Tcl_DString *dsPtr));
 /* 158 */
-EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
+EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
 /* 159 */
-EXTERN int		Tcl_GetCommandInfo(Tcl_Interp *interp,
-				const char *cmdName, Tcl_CmdInfo *infoPtr);
+EXTERN int		Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *cmdName, Tcl_CmdInfo *infoPtr));
 /* 160 */
-EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
-				Tcl_Command command);
+EXTERN CONST84_RETURN char * Tcl_GetCommandName _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Command command));
 /* 161 */
-EXTERN int		Tcl_GetErrno(void);
+EXTERN int		Tcl_GetErrno _ANSI_ARGS_((void));
 /* 162 */
-EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
+EXTERN CONST84_RETURN char * Tcl_GetHostName _ANSI_ARGS_((void));
 /* 163 */
-EXTERN int		Tcl_GetInterpPath(Tcl_Interp *askInterp,
-				Tcl_Interp *slaveInterp);
+EXTERN int		Tcl_GetInterpPath _ANSI_ARGS_((Tcl_Interp *askInterp,
+				Tcl_Interp *slaveInterp));
 /* 164 */
-EXTERN Tcl_Interp *	Tcl_GetMaster(Tcl_Interp *interp);
+EXTERN Tcl_Interp *	Tcl_GetMaster _ANSI_ARGS_((Tcl_Interp *interp));
 /* 165 */
-EXTERN const char *	Tcl_GetNameOfExecutable(void);
+EXTERN CONST char *	Tcl_GetNameOfExecutable _ANSI_ARGS_((void));
 /* 166 */
-EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+EXTERN Tcl_Obj *	Tcl_GetObjResult _ANSI_ARGS_((Tcl_Interp *interp));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 167 */
-EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
-				const char *chanID, int forWriting,
-				int checkUsage, ClientData *filePtr);
+EXTERN int		Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *chanID, int forWriting,
+				int checkUsage, ClientData *filePtr));
 #endif /* UNIX */
-#ifdef MAC_OSX_TCL /* MACOSX */
-/* 167 */
-EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
-				const char *chanID, int forWriting,
-				int checkUsage, ClientData *filePtr);
-#endif /* MACOSX */
 /* 168 */
-EXTERN Tcl_PathType	Tcl_GetPathType(const char *path);
+EXTERN Tcl_PathType	Tcl_GetPathType _ANSI_ARGS_((CONST char *path));
 /* 169 */
-EXTERN int		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
+EXTERN int		Tcl_Gets _ANSI_ARGS_((Tcl_Channel chan,
+				Tcl_DString *dsPtr));
 /* 170 */
-EXTERN int		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
+EXTERN int		Tcl_GetsObj _ANSI_ARGS_((Tcl_Channel chan,
+				Tcl_Obj *objPtr));
 /* 171 */
-EXTERN int		Tcl_GetServiceMode(void);
+EXTERN int		Tcl_GetServiceMode _ANSI_ARGS_((void));
 /* 172 */
-EXTERN Tcl_Interp *	Tcl_GetSlave(Tcl_Interp *interp,
-				const char *slaveName);
+EXTERN Tcl_Interp *	Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *slaveName));
 /* 173 */
-EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
+EXTERN Tcl_Channel	Tcl_GetStdChannel _ANSI_ARGS_((int type));
 /* 174 */
-EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
+EXTERN CONST84_RETURN char * Tcl_GetStringResult _ANSI_ARGS_((
+				Tcl_Interp *interp));
 /* 175 */
-EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
-				const char *varName, int flags);
+EXTERN CONST84_RETURN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags));
 /* 176 */
-EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
-				const char *part1, const char *part2,
-				int flags);
+EXTERN CONST84_RETURN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
+				int flags));
 /* 177 */
-EXTERN int		Tcl_GlobalEval(Tcl_Interp *interp,
-				const char *command);
+EXTERN int		Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *command));
 /* 178 */
-EXTERN int		Tcl_GlobalEvalObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr);
+EXTERN int		Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr));
 /* 179 */
-EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
-				const char *cmdName,
-				const char *hiddenCmdToken);
+EXTERN int		Tcl_HideCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *cmdName,
+				CONST char *hiddenCmdToken));
 /* 180 */
-EXTERN int		Tcl_Init(Tcl_Interp *interp);
+EXTERN int		Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
 /* 181 */
-EXTERN void		Tcl_InitHashTable(Tcl_HashTable *tablePtr,
-				int keyType);
+EXTERN void		Tcl_InitHashTable _ANSI_ARGS_((
+				Tcl_HashTable *tablePtr, int keyType));
 /* 182 */
-EXTERN int		Tcl_InputBlocked(Tcl_Channel chan);
+EXTERN int		Tcl_InputBlocked _ANSI_ARGS_((Tcl_Channel chan));
 /* 183 */
-EXTERN int		Tcl_InputBuffered(Tcl_Channel chan);
+EXTERN int		Tcl_InputBuffered _ANSI_ARGS_((Tcl_Channel chan));
 /* 184 */
-EXTERN int		Tcl_InterpDeleted(Tcl_Interp *interp);
+EXTERN int		Tcl_InterpDeleted _ANSI_ARGS_((Tcl_Interp *interp));
 /* 185 */
-EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
+EXTERN int		Tcl_IsSafe _ANSI_ARGS_((Tcl_Interp *interp));
 /* 186 */
-EXTERN char *		Tcl_JoinPath(int argc, CONST84 char *const *argv,
-				Tcl_DString *resultPtr);
+EXTERN char *		Tcl_JoinPath _ANSI_ARGS_((int argc,
+				CONST84 char *CONST *argv,
+				Tcl_DString *resultPtr));
 /* 187 */
-EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
-				char *addr, int type);
+EXTERN int		Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, char *addr, int type));
 /* Slot 188 is reserved */
 /* 189 */
-EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
+EXTERN Tcl_Channel	Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
+				int mode));
 /* 190 */
-EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
+EXTERN int		Tcl_MakeSafe _ANSI_ARGS_((Tcl_Interp *interp));
 /* 191 */
-EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
+EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel _ANSI_ARGS_((
+				ClientData tcpSocket));
 /* 192 */
-EXTERN char *		Tcl_Merge(int argc, CONST84 char *const *argv);
+EXTERN char *		Tcl_Merge _ANSI_ARGS_((int argc,
+				CONST84 char *CONST *argv));
 /* 193 */
-EXTERN Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
+EXTERN Tcl_HashEntry *	Tcl_NextHashEntry _ANSI_ARGS_((
+				Tcl_HashSearch *searchPtr));
 /* 194 */
-EXTERN void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
+EXTERN void		Tcl_NotifyChannel _ANSI_ARGS_((Tcl_Channel channel,
+				int mask));
 /* 195 */
-EXTERN Tcl_Obj *	Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
-				Tcl_Obj *part2Ptr, int flags);
+EXTERN Tcl_Obj *	Tcl_ObjGetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+				int flags));
 /* 196 */
-EXTERN Tcl_Obj *	Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
-				Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
-				int flags);
+EXTERN Tcl_Obj *	Tcl_ObjSetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+				Tcl_Obj *newValuePtr, int flags));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 197 */
-EXTERN Tcl_Channel	Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
-				CONST84 char **argv, int flags);
+EXTERN Tcl_Channel	Tcl_OpenCommandChannel _ANSI_ARGS_((
+				Tcl_Interp *interp, int argc,
+				CONST84 char **argv, int flags));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 197 */
+EXTERN Tcl_Channel	Tcl_OpenCommandChannel _ANSI_ARGS_((
+				Tcl_Interp *interp, int argc,
+				CONST84 char **argv, int flags));
+#endif /* __WIN32__ */
 /* 198 */
-EXTERN Tcl_Channel	Tcl_OpenFileChannel(Tcl_Interp *interp,
-				const char *fileName, const char *modeString,
-				int permissions);
+EXTERN Tcl_Channel	Tcl_OpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *fileName, CONST char *modeString,
+				int permissions));
 /* 199 */
-EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
-				const char *address, const char *myaddr,
-				int myport, int async);
+EXTERN Tcl_Channel	Tcl_OpenTcpClient _ANSI_ARGS_((Tcl_Interp *interp,
+				int port, CONST char *address,
+				CONST char *myaddr, int myport, int async));
 /* 200 */
-EXTERN Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
-				const char *host,
+EXTERN Tcl_Channel	Tcl_OpenTcpServer _ANSI_ARGS_((Tcl_Interp *interp,
+				int port, CONST char *host,
 				Tcl_TcpAcceptProc *acceptProc,
-				ClientData callbackData);
+				ClientData callbackData));
 /* 201 */
-EXTERN void		Tcl_Preserve(ClientData data);
+EXTERN void		Tcl_Preserve _ANSI_ARGS_((ClientData data));
 /* 202 */
-EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
-				char *dst);
+EXTERN void		Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp *interp,
+				double value, char *dst));
 /* 203 */
-EXTERN int		Tcl_PutEnv(const char *assignment);
+EXTERN int		Tcl_PutEnv _ANSI_ARGS_((CONST char *assignment));
 /* 204 */
-EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
+EXTERN CONST84_RETURN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp *interp));
 /* 205 */
-EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr,
-				Tcl_QueuePosition position);
+EXTERN void		Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event *evPtr,
+				Tcl_QueuePosition position));
 /* 206 */
-EXTERN int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
+EXTERN int		Tcl_Read _ANSI_ARGS_((Tcl_Channel chan, char *bufPtr,
+				int toRead));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 207 */
+EXTERN void		Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+#endif /* UNIX */
+#ifdef __WIN32__
 /* 207 */
-EXTERN void		Tcl_ReapDetachedProcs(void);
+EXTERN void		Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
+#endif /* __WIN32__ */
 /* 208 */
-EXTERN int		Tcl_RecordAndEval(Tcl_Interp *interp,
-				const char *cmd, int flags);
+EXTERN int		Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *cmd, int flags));
 /* 209 */
-EXTERN int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,
-				Tcl_Obj *cmdPtr, int flags);
+EXTERN int		Tcl_RecordAndEvalObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *cmdPtr, int flags));
 /* 210 */
-EXTERN void		Tcl_RegisterChannel(Tcl_Interp *interp,
-				Tcl_Channel chan);
+EXTERN void		Tcl_RegisterChannel _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan));
 /* 211 */
-EXTERN void		Tcl_RegisterObjType(const Tcl_ObjType *typePtr);
+EXTERN void		Tcl_RegisterObjType _ANSI_ARGS_((
+				Tcl_ObjType *typePtr));
 /* 212 */
-EXTERN Tcl_RegExp	Tcl_RegExpCompile(Tcl_Interp *interp,
-				const char *pattern);
+EXTERN Tcl_RegExp	Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *pattern));
 /* 213 */
-EXTERN int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
-				const char *text, const char *start);
+EXTERN int		Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_RegExp regexp, CONST char *text,
+				CONST char *start));
 /* 214 */
-EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
-				const char *pattern);
+EXTERN int		Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *text, CONST char *pattern));
 /* 215 */
-EXTERN void		Tcl_RegExpRange(Tcl_RegExp regexp, int index,
-				CONST84 char **startPtr,
-				CONST84 char **endPtr);
+EXTERN void		Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
+				int index, CONST84 char **startPtr,
+				CONST84 char **endPtr));
 /* 216 */
-EXTERN void		Tcl_Release(ClientData clientData);
+EXTERN void		Tcl_Release _ANSI_ARGS_((ClientData clientData));
 /* 217 */
-EXTERN void		Tcl_ResetResult(Tcl_Interp *interp);
+EXTERN void		Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
 /* 218 */
-EXTERN int		Tcl_ScanElement(const char *src, int *flagPtr);
+EXTERN int		Tcl_ScanElement _ANSI_ARGS_((CONST char *src,
+				int *flagPtr));
 /* 219 */
-EXTERN int		Tcl_ScanCountedElement(const char *src, int length,
-				int *flagPtr);
+EXTERN int		Tcl_ScanCountedElement _ANSI_ARGS_((CONST char *src,
+				int length, int *flagPtr));
 /* 220 */
-EXTERN int		Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
+EXTERN int		Tcl_SeekOld _ANSI_ARGS_((Tcl_Channel chan,
+				int offset, int mode));
 /* 221 */
-EXTERN int		Tcl_ServiceAll(void);
+EXTERN int		Tcl_ServiceAll _ANSI_ARGS_((void));
 /* 222 */
-EXTERN int		Tcl_ServiceEvent(int flags);
+EXTERN int		Tcl_ServiceEvent _ANSI_ARGS_((int flags));
 /* 223 */
-EXTERN void		Tcl_SetAssocData(Tcl_Interp *interp,
-				const char *name, Tcl_InterpDeleteProc *proc,
-				ClientData clientData);
+EXTERN void		Tcl_SetAssocData _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, Tcl_InterpDeleteProc *proc,
+				ClientData clientData));
 /* 224 */
-EXTERN void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
+EXTERN void		Tcl_SetChannelBufferSize _ANSI_ARGS_((
+				Tcl_Channel chan, int sz));
 /* 225 */
-EXTERN int		Tcl_SetChannelOption(Tcl_Interp *interp,
-				Tcl_Channel chan, const char *optionName,
-				const char *newValue);
+EXTERN int		Tcl_SetChannelOption _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan, CONST char *optionName,
+				CONST char *newValue));
 /* 226 */
-EXTERN int		Tcl_SetCommandInfo(Tcl_Interp *interp,
-				const char *cmdName,
-				const Tcl_CmdInfo *infoPtr);
+EXTERN int		Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *cmdName,
+				CONST Tcl_CmdInfo *infoPtr));
 /* 227 */
-EXTERN void		Tcl_SetErrno(int err);
+EXTERN void		Tcl_SetErrno _ANSI_ARGS_((int err));
 /* 228 */
-EXTERN void		Tcl_SetErrorCode(Tcl_Interp *interp, ...);
+EXTERN void		Tcl_SetErrorCode _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
 /* 229 */
-EXTERN void		Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
+EXTERN void		Tcl_SetMaxBlockTime _ANSI_ARGS_((Tcl_Time *timePtr));
 /* 230 */
-EXTERN void		Tcl_SetPanicProc(Tcl_PanicProc *panicProc);
+EXTERN void		Tcl_SetPanicProc _ANSI_ARGS_((
+				Tcl_PanicProc *panicProc));
 /* 231 */
-EXTERN int		Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
+EXTERN int		Tcl_SetRecursionLimit _ANSI_ARGS_((
+				Tcl_Interp *interp, int depth));
 /* 232 */
-EXTERN void		Tcl_SetResult(Tcl_Interp *interp, char *result,
-				Tcl_FreeProc *freeProc);
+EXTERN void		Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
+				char *result, Tcl_FreeProc *freeProc));
 /* 233 */
-EXTERN int		Tcl_SetServiceMode(int mode);
+EXTERN int		Tcl_SetServiceMode _ANSI_ARGS_((int mode));
 /* 234 */
-EXTERN void		Tcl_SetObjErrorCode(Tcl_Interp *interp,
-				Tcl_Obj *errorObjPtr);
+EXTERN void		Tcl_SetObjErrorCode _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *errorObjPtr));
 /* 235 */
-EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
-				Tcl_Obj *resultObjPtr);
+EXTERN void		Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *resultObjPtr));
 /* 236 */
-EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
+EXTERN void		Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
+				int type));
 /* 237 */
-EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
-				const char *varName, const char *newValue,
-				int flags);
+EXTERN CONST84_RETURN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, CONST char *newValue,
+				int flags));
 /* 238 */
-EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
-				const char *part1, const char *part2,
-				const char *newValue, int flags);
+EXTERN CONST84_RETURN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
+				CONST char *newValue, int flags));
 /* 239 */
-EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
+EXTERN CONST84_RETURN char * Tcl_SignalId _ANSI_ARGS_((int sig));
 /* 240 */
-EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
+EXTERN CONST84_RETURN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
 /* 241 */
-EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
+EXTERN void		Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp *interp));
 /* 242 */
-EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
-				const char *listStr, int *argcPtr,
-				CONST84 char ***argvPtr);
+EXTERN int		Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *listStr, int *argcPtr,
+				CONST84 char ***argvPtr));
 /* 243 */
-EXTERN void		Tcl_SplitPath(const char *path, int *argcPtr,
-				CONST84 char ***argvPtr);
+EXTERN void		Tcl_SplitPath _ANSI_ARGS_((CONST char *path,
+				int *argcPtr, CONST84 char ***argvPtr));
 /* 244 */
-EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
-				const char *pkgName,
+EXTERN void		Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *pkgName,
 				Tcl_PackageInitProc *initProc,
-				Tcl_PackageInitProc *safeInitProc);
+				Tcl_PackageInitProc *safeInitProc));
 /* 245 */
-EXTERN int		Tcl_StringMatch(const char *str, const char *pattern);
+EXTERN int		Tcl_StringMatch _ANSI_ARGS_((CONST char *str,
+				CONST char *pattern));
 /* 246 */
-EXTERN int		Tcl_TellOld(Tcl_Channel chan);
+EXTERN int		Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan));
 /* 247 */
-EXTERN int		Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
-				int flags, Tcl_VarTraceProc *proc,
-				ClientData clientData);
-/* 248 */
-EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
-				const char *part2, int flags,
+EXTERN int		Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags,
 				Tcl_VarTraceProc *proc,
-				ClientData clientData);
+				ClientData clientData));
+/* 248 */
+EXTERN int		Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
+				int flags, Tcl_VarTraceProc *proc,
+				ClientData clientData));
 /* 249 */
-EXTERN char *		Tcl_TranslateFileName(Tcl_Interp *interp,
-				const char *name, Tcl_DString *bufferPtr);
+EXTERN char *		Tcl_TranslateFileName _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *name,
+				Tcl_DString *bufferPtr));
 /* 250 */
-EXTERN int		Tcl_Ungets(Tcl_Channel chan, const char *str,
-				int len, int atHead);
+EXTERN int		Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan,
+				CONST char *str, int len, int atHead));
 /* 251 */
-EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
-				const char *varName);
+EXTERN void		Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName));
 /* 252 */
-EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
-				Tcl_Channel chan);
+EXTERN int		Tcl_UnregisterChannel _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Channel chan));
 /* 253 */
-EXTERN int		Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
-				int flags);
+EXTERN int		Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags));
 /* 254 */
-EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
-				const char *part2, int flags);
+EXTERN int		Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
+				int flags));
 /* 255 */
-EXTERN void		Tcl_UntraceVar(Tcl_Interp *interp,
-				const char *varName, int flags,
+EXTERN void		Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags,
 				Tcl_VarTraceProc *proc,
-				ClientData clientData);
+				ClientData clientData));
 /* 256 */
-EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
-				const char *part1, const char *part2,
+EXTERN void		Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
 				int flags, Tcl_VarTraceProc *proc,
-				ClientData clientData);
+				ClientData clientData));
 /* 257 */
-EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
-				const char *varName);
+EXTERN void		Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName));
 /* 258 */
-EXTERN int		Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
-				const char *varName, const char *localName,
-				int flags);
+EXTERN int		Tcl_UpVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *frameName, CONST char *varName,
+				CONST char *localName, int flags));
 /* 259 */
-EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
-				const char *part1, const char *part2,
-				const char *localName, int flags);
+EXTERN int		Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *frameName, CONST char *part1,
+				CONST char *part2, CONST char *localName,
+				int flags));
 /* 260 */
-EXTERN int		Tcl_VarEval(Tcl_Interp *interp, ...);
+EXTERN int		Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
 /* 261 */
-EXTERN ClientData	Tcl_VarTraceInfo(Tcl_Interp *interp,
-				const char *varName, int flags,
+EXTERN ClientData	Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags,
 				Tcl_VarTraceProc *procPtr,
-				ClientData prevClientData);
+				ClientData prevClientData));
 /* 262 */
-EXTERN ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
-				const char *part1, const char *part2,
+EXTERN ClientData	Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
 				int flags, Tcl_VarTraceProc *procPtr,
-				ClientData prevClientData);
+				ClientData prevClientData));
 /* 263 */
-EXTERN int		Tcl_Write(Tcl_Channel chan, const char *s, int slen);
+EXTERN int		Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
+				CONST char *s, int slen));
 /* 264 */
-EXTERN void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[], const char *message);
+EXTERN void		Tcl_WrongNumArgs _ANSI_ARGS_((Tcl_Interp *interp,
+				int objc, Tcl_Obj *CONST objv[],
+				CONST char *message));
 /* 265 */
-EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
+EXTERN int		Tcl_DumpActiveMemory _ANSI_ARGS_((
+				CONST char *fileName));
 /* 266 */
-EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
+EXTERN void		Tcl_ValidateAllMemory _ANSI_ARGS_((CONST char *file,
+				int line));
 /* 267 */
-EXTERN void		Tcl_AppendResultVA(Tcl_Interp *interp,
-				va_list argList);
+EXTERN void		Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp *interp,
+				va_list argList));
 /* 268 */
-EXTERN void		Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
-				va_list argList);
+EXTERN void		Tcl_AppendStringsToObjVA _ANSI_ARGS_((
+				Tcl_Obj *objPtr, va_list argList));
 /* 269 */
-EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
+EXTERN char *		Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
 /* 270 */
-EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
-				const char *start, CONST84 char **termPtr);
+EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *start, CONST84 char **termPtr));
 /* 271 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
-				const char *name, const char *version,
-				int exact);
+EXTERN CONST84_RETURN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, CONST char *version,
+				int exact));
 /* 272 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
-				const char *name, const char *version,
-				int exact, void *clientDataPtr);
+EXTERN CONST84_RETURN char * Tcl_PkgPresentEx _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *name,
+				CONST char *version, int exact,
+				ClientData *clientDataPtr));
 /* 273 */
-EXTERN int		Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
-				const char *version);
+EXTERN int		Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, CONST char *version));
 /* 274 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
-				const char *name, const char *version,
-				int exact);
+EXTERN CONST84_RETURN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, CONST char *version,
+				int exact));
 /* 275 */
-EXTERN void		Tcl_SetErrorCodeVA(Tcl_Interp *interp,
-				va_list argList);
+EXTERN void		Tcl_SetErrorCodeVA _ANSI_ARGS_((Tcl_Interp *interp,
+				va_list argList));
 /* 276 */
-EXTERN int		Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
+EXTERN int		Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp *interp,
+				va_list argList));
 /* 277 */
-EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
+EXTERN Tcl_Pid		Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int *statPtr,
+				int options));
 /* 278 */
-EXTERN void		Tcl_PanicVA(const char *format, va_list argList);
+EXTERN void		Tcl_PanicVA _ANSI_ARGS_((CONST char *format,
+				va_list argList));
 /* 279 */
-EXTERN void		Tcl_GetVersion(int *major, int *minor,
-				int *patchLevel, int *type);
+EXTERN void		Tcl_GetVersion _ANSI_ARGS_((int *major, int *minor,
+				int *patchLevel, int *type));
 /* 280 */
-EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
+EXTERN void		Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
 /* 281 */
-EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
-				const Tcl_ChannelType *typePtr,
+EXTERN Tcl_Channel	Tcl_StackChannel _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_ChannelType *typePtr,
 				ClientData instanceData, int mask,
-				Tcl_Channel prevChan);
+				Tcl_Channel prevChan));
 /* 282 */
-EXTERN int		Tcl_UnstackChannel(Tcl_Interp *interp,
-				Tcl_Channel chan);
+EXTERN int		Tcl_UnstackChannel _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan));
 /* 283 */
-EXTERN Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
+EXTERN Tcl_Channel	Tcl_GetStackedChannel _ANSI_ARGS_((Tcl_Channel chan));
 /* 284 */
-EXTERN void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
+EXTERN void		Tcl_SetMainLoop _ANSI_ARGS_((Tcl_MainLoopProc *proc));
 /* Slot 285 is reserved */
 /* 286 */
-EXTERN void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
-				Tcl_Obj *appendObjPtr);
+EXTERN void		Tcl_AppendObjToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				Tcl_Obj *appendObjPtr));
 /* 287 */
-EXTERN Tcl_Encoding	Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
+EXTERN Tcl_Encoding	Tcl_CreateEncoding _ANSI_ARGS_((
+				Tcl_EncodingType *typePtr));
 /* 288 */
-EXTERN void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
-				ClientData clientData);
+EXTERN void		Tcl_CreateThreadExitHandler _ANSI_ARGS_((
+				Tcl_ExitProc *proc, ClientData clientData));
 /* 289 */
-EXTERN void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
-				ClientData clientData);
+EXTERN void		Tcl_DeleteThreadExitHandler _ANSI_ARGS_((
+				Tcl_ExitProc *proc, ClientData clientData));
 /* 290 */
-EXTERN void		Tcl_DiscardResult(Tcl_SavedResult *statePtr);
+EXTERN void		Tcl_DiscardResult _ANSI_ARGS_((
+				Tcl_SavedResult *statePtr));
 /* 291 */
-EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, const char *script,
-				int numBytes, int flags);
+EXTERN int		Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *script, int numBytes, int flags));
 /* 292 */
-EXTERN int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[], int flags);
+EXTERN int		Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp *interp,
+				int objc, Tcl_Obj *CONST objv[], int flags));
 /* 293 */
-EXTERN int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags);
+EXTERN int		Tcl_EvalObjEx _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int flags));
 /* 294 */
-EXTERN void		Tcl_ExitThread(int status);
+EXTERN void		Tcl_ExitThread _ANSI_ARGS_((int status));
 /* 295 */
-EXTERN int		Tcl_ExternalToUtf(Tcl_Interp *interp,
-				Tcl_Encoding encoding, const char *src,
+EXTERN 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);
+				int *dstWrotePtr, int *dstCharsPtr));
 /* 296 */
-EXTERN char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
-				const char *src, int srcLen,
-				Tcl_DString *dsPtr);
+EXTERN char *		Tcl_ExternalToUtfDString _ANSI_ARGS_((
+				Tcl_Encoding encoding, CONST char *src,
+				int srcLen, Tcl_DString *dsPtr));
 /* 297 */
-EXTERN void		Tcl_FinalizeThread(void);
+EXTERN void		Tcl_FinalizeThread _ANSI_ARGS_((void));
 /* 298 */
-EXTERN void		Tcl_FinalizeNotifier(ClientData clientData);
+EXTERN void		Tcl_FinalizeNotifier _ANSI_ARGS_((
+				ClientData clientData));
 /* 299 */
-EXTERN void		Tcl_FreeEncoding(Tcl_Encoding encoding);
+EXTERN void		Tcl_FreeEncoding _ANSI_ARGS_((Tcl_Encoding encoding));
 /* 300 */
-EXTERN Tcl_ThreadId	Tcl_GetCurrentThread(void);
+EXTERN Tcl_ThreadId	Tcl_GetCurrentThread _ANSI_ARGS_((void));
 /* 301 */
-EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
+EXTERN Tcl_Encoding	Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name));
 /* 302 */
-EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
+EXTERN CONST84_RETURN char * Tcl_GetEncodingName _ANSI_ARGS_((
+				Tcl_Encoding encoding));
 /* 303 */
-EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
+EXTERN void		Tcl_GetEncodingNames _ANSI_ARGS_((Tcl_Interp *interp));
 /* 304 */
-EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, const void *tablePtr,
-				int offset, const char *msg, int flags,
-				int *indexPtr);
+EXTERN int		Tcl_GetIndexFromObjStruct _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *objPtr,
+				CONST VOID *tablePtr, int offset,
+				CONST char *msg, int flags, int *indexPtr));
 /* 305 */
-EXTERN void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
-				int size);
+EXTERN VOID *		Tcl_GetThreadData _ANSI_ARGS_((
+				Tcl_ThreadDataKey *keyPtr, int size));
 /* 306 */
-EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
-				const char *part2, int flags);
+EXTERN Tcl_Obj *	Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
+				int flags));
 /* 307 */
-EXTERN ClientData	Tcl_InitNotifier(void);
+EXTERN ClientData	Tcl_InitNotifier _ANSI_ARGS_((void));
 /* 308 */
-EXTERN void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
+EXTERN void		Tcl_MutexLock _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
 /* 309 */
-EXTERN void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
+EXTERN void		Tcl_MutexUnlock _ANSI_ARGS_((Tcl_Mutex *mutexPtr));
 /* 310 */
-EXTERN void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
+EXTERN void		Tcl_ConditionNotify _ANSI_ARGS_((
+				Tcl_Condition *condPtr));
 /* 311 */
-EXTERN void		Tcl_ConditionWait(Tcl_Condition *condPtr,
-				Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
+EXTERN void		Tcl_ConditionWait _ANSI_ARGS_((
+				Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
+				Tcl_Time *timePtr));
 /* 312 */
-EXTERN int		Tcl_NumUtfChars(const char *src, int length);
+EXTERN int		Tcl_NumUtfChars _ANSI_ARGS_((CONST char *src,
+				int length));
 /* 313 */
-EXTERN int		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
-				int charsToRead, int appendFlag);
+EXTERN int		Tcl_ReadChars _ANSI_ARGS_((Tcl_Channel channel,
+				Tcl_Obj *objPtr, int charsToRead,
+				int appendFlag));
 /* 314 */
-EXTERN void		Tcl_RestoreResult(Tcl_Interp *interp,
-				Tcl_SavedResult *statePtr);
+EXTERN void		Tcl_RestoreResult _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_SavedResult *statePtr));
 /* 315 */
-EXTERN void		Tcl_SaveResult(Tcl_Interp *interp,
-				Tcl_SavedResult *statePtr);
+EXTERN void		Tcl_SaveResult _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_SavedResult *statePtr));
 /* 316 */
-EXTERN int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
-				const char *name);
+EXTERN int		Tcl_SetSystemEncoding _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *name));
 /* 317 */
-EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
-				const char *part2, Tcl_Obj *newValuePtr,
-				int flags);
+EXTERN Tcl_Obj *	Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *part1, CONST char *part2,
+				Tcl_Obj *newValuePtr, int flags));
 /* 318 */
-EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
+EXTERN void		Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId));
 /* 319 */
-EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
-				Tcl_Event *evPtr, Tcl_QueuePosition position);
+EXTERN void		Tcl_ThreadQueueEvent _ANSI_ARGS_((
+				Tcl_ThreadId threadId, Tcl_Event *evPtr,
+				Tcl_QueuePosition position));
 /* 320 */
-EXTERN Tcl_UniChar	Tcl_UniCharAtIndex(const char *src, int index);
+EXTERN Tcl_UniChar	Tcl_UniCharAtIndex _ANSI_ARGS_((CONST char *src,
+				int index));
 /* 321 */
-EXTERN Tcl_UniChar	Tcl_UniCharToLower(int ch);
+EXTERN Tcl_UniChar	Tcl_UniCharToLower _ANSI_ARGS_((int ch));
 /* 322 */
-EXTERN Tcl_UniChar	Tcl_UniCharToTitle(int ch);
+EXTERN Tcl_UniChar	Tcl_UniCharToTitle _ANSI_ARGS_((int ch));
 /* 323 */
-EXTERN Tcl_UniChar	Tcl_UniCharToUpper(int ch);
+EXTERN Tcl_UniChar	Tcl_UniCharToUpper _ANSI_ARGS_((int ch));
 /* 324 */
-EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
+EXTERN int		Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char *buf));
 /* 325 */
-EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
+EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char *src,
+				int index));
 /* 326 */
-EXTERN int		Tcl_UtfCharComplete(const char *src, int length);
+EXTERN int		Tcl_UtfCharComplete _ANSI_ARGS_((CONST char *src,
+				int length));
 /* 327 */
-EXTERN int		Tcl_UtfBackslash(const char *src, int *readPtr,
-				char *dst);
+EXTERN int		Tcl_UtfBackslash _ANSI_ARGS_((CONST char *src,
+				int *readPtr, char *dst));
 /* 328 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
+EXTERN CONST84_RETURN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char *src,
+				int ch));
 /* 329 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
+EXTERN CONST84_RETURN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char *src,
+				int ch));
 /* 330 */
-EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
+EXTERN CONST84_RETURN char * Tcl_UtfNext _ANSI_ARGS_((CONST char *src));
 /* 331 */
-EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
+EXTERN CONST84_RETURN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char *src,
+				CONST char *start));
 /* 332 */
-EXTERN int		Tcl_UtfToExternal(Tcl_Interp *interp,
-				Tcl_Encoding encoding, const char *src,
+EXTERN 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);
+				int *dstWrotePtr, int *dstCharsPtr));
 /* 333 */
-EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
-				const char *src, int srcLen,
-				Tcl_DString *dsPtr);
+EXTERN char *		Tcl_UtfToExternalDString _ANSI_ARGS_((
+				Tcl_Encoding encoding, CONST char *src,
+				int srcLen, Tcl_DString *dsPtr));
 /* 334 */
-EXTERN int		Tcl_UtfToLower(char *src);
+EXTERN int		Tcl_UtfToLower _ANSI_ARGS_((char *src));
 /* 335 */
-EXTERN int		Tcl_UtfToTitle(char *src);
+EXTERN int		Tcl_UtfToTitle _ANSI_ARGS_((char *src));
 /* 336 */
-EXTERN int		Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr);
+EXTERN int		Tcl_UtfToUniChar _ANSI_ARGS_((CONST char *src,
+				Tcl_UniChar *chPtr));
 /* 337 */
-EXTERN int		Tcl_UtfToUpper(char *src);
+EXTERN int		Tcl_UtfToUpper _ANSI_ARGS_((char *src));
 /* 338 */
-EXTERN int		Tcl_WriteChars(Tcl_Channel chan, const char *src,
-				int srcLen);
+EXTERN int		Tcl_WriteChars _ANSI_ARGS_((Tcl_Channel chan,
+				CONST char *src, int srcLen));
 /* 339 */
-EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
+EXTERN int		Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan,
+				Tcl_Obj *objPtr));
 /* 340 */
-EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
+EXTERN char *		Tcl_GetString _ANSI_ARGS_((Tcl_Obj *objPtr));
 /* 341 */
-EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
+EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
 /* 342 */
-EXTERN void		Tcl_SetDefaultEncodingDir(const char *path);
+EXTERN void		Tcl_SetDefaultEncodingDir _ANSI_ARGS_((
+				CONST char *path));
 /* 343 */
-EXTERN void		Tcl_AlertNotifier(ClientData clientData);
+EXTERN void		Tcl_AlertNotifier _ANSI_ARGS_((ClientData clientData));
 /* 344 */
-EXTERN void		Tcl_ServiceModeHook(int mode);
+EXTERN void		Tcl_ServiceModeHook _ANSI_ARGS_((int mode));
 /* 345 */
-EXTERN int		Tcl_UniCharIsAlnum(int ch);
+EXTERN int		Tcl_UniCharIsAlnum _ANSI_ARGS_((int ch));
 /* 346 */
-EXTERN int		Tcl_UniCharIsAlpha(int ch);
+EXTERN int		Tcl_UniCharIsAlpha _ANSI_ARGS_((int ch));
 /* 347 */
-EXTERN int		Tcl_UniCharIsDigit(int ch);
+EXTERN int		Tcl_UniCharIsDigit _ANSI_ARGS_((int ch));
 /* 348 */
-EXTERN int		Tcl_UniCharIsLower(int ch);
+EXTERN int		Tcl_UniCharIsLower _ANSI_ARGS_((int ch));
 /* 349 */
-EXTERN int		Tcl_UniCharIsSpace(int ch);
+EXTERN int		Tcl_UniCharIsSpace _ANSI_ARGS_((int ch));
 /* 350 */
-EXTERN int		Tcl_UniCharIsUpper(int ch);
+EXTERN int		Tcl_UniCharIsUpper _ANSI_ARGS_((int ch));
 /* 351 */
-EXTERN int		Tcl_UniCharIsWordChar(int ch);
+EXTERN int		Tcl_UniCharIsWordChar _ANSI_ARGS_((int ch));
 /* 352 */
-EXTERN int		Tcl_UniCharLen(const Tcl_UniChar *uniStr);
+EXTERN int		Tcl_UniCharLen _ANSI_ARGS_((
+				CONST Tcl_UniChar *uniStr));
 /* 353 */
-EXTERN int		Tcl_UniCharNcmp(const Tcl_UniChar *ucs,
-				const Tcl_UniChar *uct,
-				unsigned long numChars);
+EXTERN int		Tcl_UniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar *ucs,
+				CONST Tcl_UniChar *uct,
+				unsigned long numChars));
 /* 354 */
-EXTERN char *		Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
-				int uniLength, Tcl_DString *dsPtr);
+EXTERN char *		Tcl_UniCharToUtfDString _ANSI_ARGS_((
+				CONST Tcl_UniChar *uniStr, int uniLength,
+				Tcl_DString *dsPtr));
 /* 355 */
-EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(const char *src, int length,
-				Tcl_DString *dsPtr);
+EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString _ANSI_ARGS_((CONST char *src,
+				int length, Tcl_DString *dsPtr));
 /* 356 */
-EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
-				Tcl_Obj *patObj, int flags);
+EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *patObj, int flags));
 /* 357 */
-EXTERN Tcl_Obj *	Tcl_EvalTokens(Tcl_Interp *interp,
-				Tcl_Token *tokenPtr, int count);
+EXTERN Tcl_Obj *	Tcl_EvalTokens _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Token *tokenPtr, int count));
 /* 358 */
-EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
+EXTERN void		Tcl_FreeParse _ANSI_ARGS_((Tcl_Parse *parsePtr));
 /* 359 */
-EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
-				const char *script, const char *command,
-				int length);
+EXTERN void		Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *script, CONST char *command,
+				int length));
 /* 360 */
-EXTERN int		Tcl_ParseBraces(Tcl_Interp *interp,
-				const char *start, int numBytes,
+EXTERN int		Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *start, int numBytes,
 				Tcl_Parse *parsePtr, int append,
-				CONST84 char **termPtr);
+				CONST84 char **termPtr));
 /* 361 */
-EXTERN int		Tcl_ParseCommand(Tcl_Interp *interp,
-				const char *start, int numBytes, int nested,
-				Tcl_Parse *parsePtr);
+EXTERN int		Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *start, int numBytes, int nested,
+				Tcl_Parse *parsePtr));
 /* 362 */
-EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
-				int numBytes, Tcl_Parse *parsePtr);
+EXTERN int		Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *start, int numBytes,
+				Tcl_Parse *parsePtr));
 /* 363 */
-EXTERN int		Tcl_ParseQuotedString(Tcl_Interp *interp,
-				const char *start, int numBytes,
-				Tcl_Parse *parsePtr, int append,
-				CONST84 char **termPtr);
+EXTERN int		Tcl_ParseQuotedString _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *start,
+				int numBytes, Tcl_Parse *parsePtr,
+				int append, CONST84 char **termPtr));
 /* 364 */
-EXTERN int		Tcl_ParseVarName(Tcl_Interp *interp,
-				const char *start, int numBytes,
-				Tcl_Parse *parsePtr, int append);
+EXTERN int		Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *start, int numBytes,
+				Tcl_Parse *parsePtr, int append));
 /* 365 */
-EXTERN char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
+EXTERN char *		Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_DString *cwdPtr));
 /* 366 */
-EXTERN int		Tcl_Chdir(const char *dirName);
+EXTERN int		Tcl_Chdir _ANSI_ARGS_((CONST char *dirName));
 /* 367 */
-EXTERN int		Tcl_Access(const char *path, int mode);
+EXTERN int		Tcl_Access _ANSI_ARGS_((CONST char *path, int mode));
 /* 368 */
-EXTERN int		Tcl_Stat(const char *path, struct stat *bufPtr);
+EXTERN int		Tcl_Stat _ANSI_ARGS_((CONST char *path,
+				struct stat *bufPtr));
 /* 369 */
-EXTERN int		Tcl_UtfNcmp(const char *s1, const char *s2,
-				unsigned long n);
+EXTERN int		Tcl_UtfNcmp _ANSI_ARGS_((CONST char *s1,
+				CONST char *s2, unsigned long n));
 /* 370 */
-EXTERN int		Tcl_UtfNcasecmp(const char *s1, const char *s2,
-				unsigned long n);
+EXTERN int		Tcl_UtfNcasecmp _ANSI_ARGS_((CONST char *s1,
+				CONST char *s2, unsigned long n));
 /* 371 */
-EXTERN int		Tcl_StringCaseMatch(const char *str,
-				const char *pattern, int nocase);
+EXTERN int		Tcl_StringCaseMatch _ANSI_ARGS_((CONST char *str,
+				CONST char *pattern, int nocase));
 /* 372 */
-EXTERN int		Tcl_UniCharIsControl(int ch);
+EXTERN int		Tcl_UniCharIsControl _ANSI_ARGS_((int ch));
 /* 373 */
-EXTERN int		Tcl_UniCharIsGraph(int ch);
+EXTERN int		Tcl_UniCharIsGraph _ANSI_ARGS_((int ch));
 /* 374 */
-EXTERN int		Tcl_UniCharIsPrint(int ch);
+EXTERN int		Tcl_UniCharIsPrint _ANSI_ARGS_((int ch));
 /* 375 */
-EXTERN int		Tcl_UniCharIsPunct(int ch);
+EXTERN int		Tcl_UniCharIsPunct _ANSI_ARGS_((int ch));
 /* 376 */
-EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
+EXTERN int		Tcl_RegExpExecObj _ANSI_ARGS_((Tcl_Interp *interp,
 				Tcl_RegExp regexp, Tcl_Obj *textObj,
-				int offset, int nmatches, int flags);
+				int offset, int nmatches, int flags));
 /* 377 */
-EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
-				Tcl_RegExpInfo *infoPtr);
+EXTERN void		Tcl_RegExpGetInfo _ANSI_ARGS_((Tcl_RegExp regexp,
+				Tcl_RegExpInfo *infoPtr));
 /* 378 */
-EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
-				int numChars);
+EXTERN Tcl_Obj *	Tcl_NewUnicodeObj _ANSI_ARGS_((
+				CONST Tcl_UniChar *unicode, int numChars));
 /* 379 */
-EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
-				const Tcl_UniChar *unicode, int numChars);
+EXTERN void		Tcl_SetUnicodeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST Tcl_UniChar *unicode, int numChars));
 /* 380 */
-EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
+EXTERN int		Tcl_GetCharLength _ANSI_ARGS_((Tcl_Obj *objPtr));
 /* 381 */
-EXTERN Tcl_UniChar	Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
+EXTERN Tcl_UniChar	Tcl_GetUniChar _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int index));
 /* 382 */
-EXTERN Tcl_UniChar *	Tcl_GetUnicode(Tcl_Obj *objPtr);
+EXTERN Tcl_UniChar *	Tcl_GetUnicode _ANSI_ARGS_((Tcl_Obj *objPtr));
 /* 383 */
-EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
+EXTERN Tcl_Obj *	Tcl_GetRange _ANSI_ARGS_((Tcl_Obj *objPtr, int first,
+				int last));
 /* 384 */
-EXTERN void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
-				const Tcl_UniChar *unicode, int length);
+EXTERN void		Tcl_AppendUnicodeToObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				CONST Tcl_UniChar *unicode, int length));
 /* 385 */
-EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
-				Tcl_Obj *textObj, Tcl_Obj *patternObj);
+EXTERN int		Tcl_RegExpMatchObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *textObj, Tcl_Obj *patternObj));
 /* 386 */
-EXTERN void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
+EXTERN void		Tcl_SetNotifier _ANSI_ARGS_((
+				Tcl_NotifierProcs *notifierProcPtr));
 /* 387 */
-EXTERN Tcl_Mutex *	Tcl_GetAllocMutex(void);
+EXTERN Tcl_Mutex *	Tcl_GetAllocMutex _ANSI_ARGS_((void));
 /* 388 */
-EXTERN int		Tcl_GetChannelNames(Tcl_Interp *interp);
+EXTERN int		Tcl_GetChannelNames _ANSI_ARGS_((Tcl_Interp *interp));
 /* 389 */
-EXTERN int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
-				const char *pattern);
+EXTERN int		Tcl_GetChannelNamesEx _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *pattern));
 /* 390 */
-EXTERN int		Tcl_ProcObjCmd(ClientData clientData,
+EXTERN int		Tcl_ProcObjCmd _ANSI_ARGS_((ClientData clientData,
 				Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[]);
+				Tcl_Obj *CONST objv[]));
 /* 391 */
-EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
+EXTERN void		Tcl_ConditionFinalize _ANSI_ARGS_((
+				Tcl_Condition *condPtr));
 /* 392 */
-EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
+EXTERN void		Tcl_MutexFinalize _ANSI_ARGS_((Tcl_Mutex *mutex));
 /* 393 */
-EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
-				Tcl_ThreadCreateProc *proc,
+EXTERN int		Tcl_CreateThread _ANSI_ARGS_((Tcl_ThreadId *idPtr,
+				Tcl_ThreadCreateProc proc,
 				ClientData clientData, int stackSize,
-				int flags);
+				int flags));
 /* 394 */
-EXTERN int		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
-				int bytesToRead);
+EXTERN int		Tcl_ReadRaw _ANSI_ARGS_((Tcl_Channel chan, char *dst,
+				int bytesToRead));
 /* 395 */
-EXTERN int		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
-				int srcLen);
+EXTERN int		Tcl_WriteRaw _ANSI_ARGS_((Tcl_Channel chan,
+				CONST char *src, int srcLen));
 /* 396 */
-EXTERN Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
+EXTERN Tcl_Channel	Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan));
 /* 397 */
-EXTERN int		Tcl_ChannelBuffered(Tcl_Channel chan);
+EXTERN int		Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan));
 /* 398 */
-EXTERN CONST84_RETURN char * Tcl_ChannelName(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN CONST84_RETURN char * Tcl_ChannelName _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 399 */
-EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 400 */
-EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 401 */
-EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 402 */
-EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 403 */
-EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 404 */
-EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 405 */
-EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 406 */
-EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 407 */
-EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 408 */
-EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 409 */
-EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 410 */
-EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 411 */
-EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(
-				const Tcl_ChannelType *chanTypePtr);
+EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc _ANSI_ARGS_((
+				Tcl_ChannelType *chanTypePtr));
 /* 412 */
-EXTERN int		Tcl_JoinThread(Tcl_ThreadId threadId, int *result);
+EXTERN int		Tcl_JoinThread _ANSI_ARGS_((Tcl_ThreadId threadId,
+				int *result));
 /* 413 */
-EXTERN int		Tcl_IsChannelShared(Tcl_Channel channel);
+EXTERN int		Tcl_IsChannelShared _ANSI_ARGS_((Tcl_Channel channel));
 /* 414 */
-EXTERN int		Tcl_IsChannelRegistered(Tcl_Interp *interp,
-				Tcl_Channel channel);
+EXTERN int		Tcl_IsChannelRegistered _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Channel channel));
 /* 415 */
-EXTERN void		Tcl_CutChannel(Tcl_Channel channel);
+EXTERN void		Tcl_CutChannel _ANSI_ARGS_((Tcl_Channel channel));
 /* 416 */
-EXTERN void		Tcl_SpliceChannel(Tcl_Channel channel);
+EXTERN void		Tcl_SpliceChannel _ANSI_ARGS_((Tcl_Channel channel));
 /* 417 */
-EXTERN void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
+EXTERN void		Tcl_ClearChannelHandlers _ANSI_ARGS_((
+				Tcl_Channel channel));
 /* 418 */
-EXTERN int		Tcl_IsChannelExisting(const char *channelName);
+EXTERN int		Tcl_IsChannelExisting _ANSI_ARGS_((
+				CONST char *channelName));
 /* 419 */
-EXTERN int		Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
-				const Tcl_UniChar *uct,
-				unsigned long numChars);
+EXTERN int		Tcl_UniCharNcasecmp _ANSI_ARGS_((
+				CONST Tcl_UniChar *ucs,
+				CONST Tcl_UniChar *uct,
+				unsigned long numChars));
 /* 420 */
-EXTERN int		Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
-				const Tcl_UniChar *uniPattern, int nocase);
+EXTERN int		Tcl_UniCharCaseMatch _ANSI_ARGS_((
+				CONST Tcl_UniChar *uniStr,
+				CONST Tcl_UniChar *uniPattern, int nocase));
 /* 421 */
-EXTERN Tcl_HashEntry *	Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
-				const void *key);
+EXTERN Tcl_HashEntry *	Tcl_FindHashEntry _ANSI_ARGS_((
+				Tcl_HashTable *tablePtr, CONST char *key));
 /* 422 */
-EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
-				const void *key, int *newPtr);
+EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry _ANSI_ARGS_((
+				Tcl_HashTable *tablePtr, CONST char *key,
+				int *newPtr));
 /* 423 */
-EXTERN void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
-				int keyType, const Tcl_HashKeyType *typePtr);
+EXTERN void		Tcl_InitCustomHashTable _ANSI_ARGS_((
+				Tcl_HashTable *tablePtr, int keyType,
+				Tcl_HashKeyType *typePtr));
 /* 424 */
-EXTERN void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
+EXTERN void		Tcl_InitObjHashTable _ANSI_ARGS_((
+				Tcl_HashTable *tablePtr));
 /* 425 */
-EXTERN ClientData	Tcl_CommandTraceInfo(Tcl_Interp *interp,
-				const char *varName, int flags,
+EXTERN ClientData	Tcl_CommandTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags,
 				Tcl_CommandTraceProc *procPtr,
-				ClientData prevClientData);
+				ClientData prevClientData));
 /* 426 */
-EXTERN int		Tcl_TraceCommand(Tcl_Interp *interp,
-				const char *varName, int flags,
+EXTERN int		Tcl_TraceCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags,
 				Tcl_CommandTraceProc *proc,
-				ClientData clientData);
+				ClientData clientData));
 /* 427 */
-EXTERN void		Tcl_UntraceCommand(Tcl_Interp *interp,
-				const char *varName, int flags,
+EXTERN void		Tcl_UntraceCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName, int flags,
 				Tcl_CommandTraceProc *proc,
-				ClientData clientData);
+				ClientData clientData));
 /* 428 */
-EXTERN char *		Tcl_AttemptAlloc(unsigned int size);
+EXTERN char *		Tcl_AttemptAlloc _ANSI_ARGS_((unsigned int size));
 /* 429 */
-EXTERN char *		Tcl_AttemptDbCkalloc(unsigned int size,
-				const char *file, int line);
+EXTERN char *		Tcl_AttemptDbCkalloc _ANSI_ARGS_((unsigned int size,
+				CONST char *file, int line));
 /* 430 */
-EXTERN char *		Tcl_AttemptRealloc(char *ptr, unsigned int size);
+EXTERN char *		Tcl_AttemptRealloc _ANSI_ARGS_((char *ptr,
+				unsigned int size));
 /* 431 */
-EXTERN char *		Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
-				const char *file, int line);
+EXTERN char *		Tcl_AttemptDbCkrealloc _ANSI_ARGS_((char *ptr,
+				unsigned int size, CONST char *file,
+				int line));
 /* 432 */
-EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
+EXTERN int		Tcl_AttemptSetObjLength _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int length));
 /* 433 */
-EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
+EXTERN Tcl_ThreadId	Tcl_GetChannelThread _ANSI_ARGS_((
+				Tcl_Channel channel));
 /* 434 */
-EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
-				int *lengthPtr);
+EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				int *lengthPtr));
 /* 435 */
-EXTERN int		Tcl_GetMathFuncInfo(Tcl_Interp *interp,
-				const char *name, int *numArgsPtr,
+EXTERN int		Tcl_GetMathFuncInfo _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, int *numArgsPtr,
 				Tcl_ValueType **argTypesPtr,
 				Tcl_MathProc **procPtr,
-				ClientData *clientDataPtr);
+				ClientData *clientDataPtr));
 /* 436 */
-EXTERN Tcl_Obj *	Tcl_ListMathFuncs(Tcl_Interp *interp,
-				const char *pattern);
+EXTERN Tcl_Obj *	Tcl_ListMathFuncs _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *pattern));
 /* 437 */
-EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags);
+EXTERN Tcl_Obj *	Tcl_SubstObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int flags));
 /* 438 */
-EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
-				Tcl_Channel channel);
+EXTERN int		Tcl_DetachChannel _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel channel));
 /* 439 */
-EXTERN int		Tcl_IsStandardChannel(Tcl_Channel channel);
+EXTERN int		Tcl_IsStandardChannel _ANSI_ARGS_((
+				Tcl_Channel channel));
 /* 440 */
-EXTERN int		Tcl_FSCopyFile(Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr);
+EXTERN int		Tcl_FSCopyFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr));
 /* 441 */
-EXTERN int		Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
+EXTERN int		Tcl_FSCopyDirectory _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
 /* 442 */
-EXTERN int		Tcl_FSCreateDirectory(Tcl_Obj *pathPtr);
+EXTERN int		Tcl_FSCreateDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 443 */
-EXTERN int		Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
+EXTERN int		Tcl_FSDeleteFile _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 444 */
-EXTERN int		Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-				const char *sym1, const char *sym2,
+EXTERN 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);
+				Tcl_FSUnloadFileProc **unloadProcPtr));
 /* 445 */
-EXTERN int		Tcl_FSMatchInDirectory(Tcl_Interp *interp,
-				Tcl_Obj *result, Tcl_Obj *pathPtr,
-				const char *pattern, Tcl_GlobTypeData *types);
+EXTERN int		Tcl_FSMatchInDirectory _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *result,
+				Tcl_Obj *pathPtr, CONST char *pattern,
+				Tcl_GlobTypeData *types));
 /* 446 */
-EXTERN Tcl_Obj *	Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
-				int linkAction);
+EXTERN Tcl_Obj *	Tcl_FSLink _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				Tcl_Obj *toPtr, int linkAction));
 /* 447 */
-EXTERN int		Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
-				int recursive, Tcl_Obj **errorPtr);
+EXTERN int		Tcl_FSRemoveDirectory _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				int recursive, Tcl_Obj **errorPtr));
 /* 448 */
-EXTERN int		Tcl_FSRenameFile(Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr);
+EXTERN int		Tcl_FSRenameFile _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
+				Tcl_Obj *destPathPtr));
 /* 449 */
-EXTERN int		Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+EXTERN int		Tcl_FSLstat _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				Tcl_StatBuf *buf));
 /* 450 */
-EXTERN int		Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
+EXTERN int		Tcl_FSUtime _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				struct utimbuf *tval));
 /* 451 */
-EXTERN int		Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
-				Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
+EXTERN int		Tcl_FSFileAttrsGet _ANSI_ARGS_((Tcl_Interp *interp,
+				int index, Tcl_Obj *pathPtr,
+				Tcl_Obj **objPtrRef));
 /* 452 */
-EXTERN int		Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
-				Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
+EXTERN int		Tcl_FSFileAttrsSet _ANSI_ARGS_((Tcl_Interp *interp,
+				int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr));
 /* 453 */
-EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
-				Tcl_Obj **objPtrRef);
+EXTERN CONST char **	Tcl_FSFileAttrStrings _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				Tcl_Obj **objPtrRef));
 /* 454 */
-EXTERN int		Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+EXTERN int		Tcl_FSStat _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				Tcl_StatBuf *buf));
 /* 455 */
-EXTERN int		Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
+EXTERN int		Tcl_FSAccess _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
 /* 456 */
-EXTERN Tcl_Channel	Tcl_FSOpenFileChannel(Tcl_Interp *interp,
-				Tcl_Obj *pathPtr, const char *modeString,
-				int permissions);
+EXTERN Tcl_Channel	Tcl_FSOpenFileChannel _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *pathPtr,
+				CONST char *modeString, int permissions));
 /* 457 */
-EXTERN Tcl_Obj *	Tcl_FSGetCwd(Tcl_Interp *interp);
+EXTERN Tcl_Obj *	Tcl_FSGetCwd _ANSI_ARGS_((Tcl_Interp *interp));
 /* 458 */
-EXTERN int		Tcl_FSChdir(Tcl_Obj *pathPtr);
+EXTERN int		Tcl_FSChdir _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 459 */
-EXTERN int		Tcl_FSConvertToPathType(Tcl_Interp *interp,
-				Tcl_Obj *pathPtr);
+EXTERN int		Tcl_FSConvertToPathType _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *pathPtr));
 /* 460 */
-EXTERN Tcl_Obj *	Tcl_FSJoinPath(Tcl_Obj *listObj, int elements);
+EXTERN Tcl_Obj *	Tcl_FSJoinPath _ANSI_ARGS_((Tcl_Obj *listObj,
+				int elements));
 /* 461 */
-EXTERN Tcl_Obj *	Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
+EXTERN Tcl_Obj *	Tcl_FSSplitPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				int *lenPtr));
 /* 462 */
-EXTERN int		Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
-				Tcl_Obj *secondPtr);
+EXTERN int		Tcl_FSEqualPaths _ANSI_ARGS_((Tcl_Obj *firstPtr,
+				Tcl_Obj *secondPtr));
 /* 463 */
-EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
-				Tcl_Obj *pathPtr);
+EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *pathPtr));
 /* 464 */
-EXTERN Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
-				Tcl_Obj *const objv[]);
+EXTERN Tcl_Obj *	Tcl_FSJoinToPath _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				int objc, Tcl_Obj *CONST objv[]));
 /* 465 */
-EXTERN ClientData	Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
-				const Tcl_Filesystem *fsPtr);
+EXTERN ClientData	Tcl_FSGetInternalRep _ANSI_ARGS_((Tcl_Obj *pathPtr,
+				Tcl_Filesystem *fsPtr));
 /* 466 */
-EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
-				Tcl_Obj *pathPtr);
+EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *pathPtr));
 /* 467 */
-EXTERN int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
+EXTERN int		Tcl_FSEvalFile _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *fileName));
 /* 468 */
-EXTERN Tcl_Obj *	Tcl_FSNewNativePath(
-				const Tcl_Filesystem *fromFilesystem,
-				ClientData clientData);
+EXTERN Tcl_Obj *	Tcl_FSNewNativePath _ANSI_ARGS_((
+				Tcl_Filesystem *fromFilesystem,
+				ClientData clientData));
 /* 469 */
-EXTERN const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
+EXTERN CONST char *	Tcl_FSGetNativePath _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 470 */
-EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
+EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 471 */
-EXTERN Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
+EXTERN Tcl_Obj *	Tcl_FSPathSeparator _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 472 */
-EXTERN Tcl_Obj *	Tcl_FSListVolumes(void);
+EXTERN Tcl_Obj *	Tcl_FSListVolumes _ANSI_ARGS_((void));
 /* 473 */
-EXTERN int		Tcl_FSRegister(ClientData clientData,
-				const Tcl_Filesystem *fsPtr);
+EXTERN int		Tcl_FSRegister _ANSI_ARGS_((ClientData clientData,
+				Tcl_Filesystem *fsPtr));
 /* 474 */
-EXTERN int		Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
+EXTERN int		Tcl_FSUnregister _ANSI_ARGS_((Tcl_Filesystem *fsPtr));
 /* 475 */
-EXTERN ClientData	Tcl_FSData(const Tcl_Filesystem *fsPtr);
+EXTERN ClientData	Tcl_FSData _ANSI_ARGS_((Tcl_Filesystem *fsPtr));
 /* 476 */
-EXTERN const char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
-				Tcl_Obj *pathPtr);
+EXTERN CONST char *	Tcl_FSGetTranslatedStringPath _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *pathPtr));
 /* 477 */
-EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
+EXTERN Tcl_Filesystem *	 Tcl_FSGetFileSystemForPath _ANSI_ARGS_((
+				Tcl_Obj *pathPtr));
 /* 478 */
-EXTERN Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
+EXTERN Tcl_PathType	Tcl_FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 479 */
-EXTERN int		Tcl_OutputBuffered(Tcl_Channel chan);
+EXTERN int		Tcl_OutputBuffered _ANSI_ARGS_((Tcl_Channel chan));
 /* 480 */
-EXTERN void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
+EXTERN void		Tcl_FSMountsChanged _ANSI_ARGS_((
+				Tcl_Filesystem *fsPtr));
 /* 481 */
-EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
-				Tcl_Token *tokenPtr, int count);
+EXTERN int		Tcl_EvalTokensStandard _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Token *tokenPtr,
+				int count));
 /* 482 */
-EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
+EXTERN void		Tcl_GetTime _ANSI_ARGS_((Tcl_Time *timeBuf));
 /* 483 */
-EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
-				int flags, Tcl_CmdObjTraceProc *objProc,
+EXTERN Tcl_Trace	Tcl_CreateObjTrace _ANSI_ARGS_((Tcl_Interp *interp,
+				int level, int flags,
+				Tcl_CmdObjTraceProc *objProc,
 				ClientData clientData,
-				Tcl_CmdObjTraceDeleteProc *delProc);
+				Tcl_CmdObjTraceDeleteProc *delProc));
 /* 484 */
-EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
-				Tcl_CmdInfo *infoPtr);
+EXTERN int		Tcl_GetCommandInfoFromToken _ANSI_ARGS_((
+				Tcl_Command token, Tcl_CmdInfo *infoPtr));
 /* 485 */
-EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
-				const Tcl_CmdInfo *infoPtr);
+EXTERN int		Tcl_SetCommandInfoFromToken _ANSI_ARGS_((
+				Tcl_Command token,
+				CONST Tcl_CmdInfo *infoPtr));
 /* 486 */
-EXTERN Tcl_Obj *	Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
-				const char *file, int line);
+EXTERN Tcl_Obj *	Tcl_DbNewWideIntObj _ANSI_ARGS_((
+				Tcl_WideInt wideValue, CONST char *file,
+				int line));
 /* 487 */
-EXTERN int		Tcl_GetWideIntFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
+EXTERN int		Tcl_GetWideIntFromObj _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *objPtr,
+				Tcl_WideInt *widePtr));
 /* 488 */
-EXTERN Tcl_Obj *	Tcl_NewWideIntObj(Tcl_WideInt wideValue);
+EXTERN Tcl_Obj *	Tcl_NewWideIntObj _ANSI_ARGS_((Tcl_WideInt wideValue));
 /* 489 */
-EXTERN void		Tcl_SetWideIntObj(Tcl_Obj *objPtr,
-				Tcl_WideInt wideValue);
+EXTERN void		Tcl_SetWideIntObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				Tcl_WideInt wideValue));
 /* 490 */
-EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf(void);
+EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf _ANSI_ARGS_((void));
 /* 491 */
-EXTERN Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
-				int mode);
+EXTERN Tcl_WideInt	Tcl_Seek _ANSI_ARGS_((Tcl_Channel chan,
+				Tcl_WideInt offset, int mode));
 /* 492 */
-EXTERN Tcl_WideInt	Tcl_Tell(Tcl_Channel chan);
+EXTERN Tcl_WideInt	Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
 /* 493 */
-EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
-				const Tcl_ChannelType *chanTypePtr);
-/* 494 */
-EXTERN int		Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
-				Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
-/* 495 */
-EXTERN int		Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
-				Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
-/* 496 */
-EXTERN int		Tcl_DictObjRemove(Tcl_Interp *interp,
-				Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
-/* 497 */
-EXTERN int		Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
-				int *sizePtr);
-/* 498 */
-EXTERN int		Tcl_DictObjFirst(Tcl_Interp *interp,
-				Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
-				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
-				int *donePtr);
-/* 499 */
-EXTERN void		Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
-				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
-				int *donePtr);
-/* 500 */
-EXTERN void		Tcl_DictObjDone(Tcl_DictSearch *searchPtr);
-/* 501 */
-EXTERN int		Tcl_DictObjPutKeyList(Tcl_Interp *interp,
-				Tcl_Obj *dictPtr, int keyc,
-				Tcl_Obj *const *keyv, Tcl_Obj *valuePtr);
-/* 502 */
-EXTERN int		Tcl_DictObjRemoveKeyList(Tcl_Interp *interp,
-				Tcl_Obj *dictPtr, int keyc,
-				Tcl_Obj *const *keyv);
-/* 503 */
-EXTERN Tcl_Obj *	Tcl_NewDictObj(void);
-/* 504 */
-EXTERN Tcl_Obj *	Tcl_DbNewDictObj(const char *file, int line);
-/* 505 */
-EXTERN void		Tcl_RegisterConfig(Tcl_Interp *interp,
-				const char *pkgName,
-				const Tcl_Config *configuration,
-				const char *valEncoding);
-/* 506 */
-EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
-				const char *name, ClientData clientData,
-				Tcl_NamespaceDeleteProc *deleteProc);
-/* 507 */
-EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
-/* 508 */
-EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
-/* 509 */
-EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				const char *pattern, int resetListFirst);
-/* 510 */
-EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				const char *pattern, int allowOverwrite);
-/* 511 */
-EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, const char *pattern);
-/* 512 */
-EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
-/* 513 */
-EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
-/* 514 */
-EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
-				const char *name,
-				Tcl_Namespace *contextNsPtr, int flags);
-/* 515 */
-EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, const char *name,
-				Tcl_Namespace *contextNsPtr, int flags);
-/* 516 */
-EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr);
-/* 517 */
-EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
-				Tcl_Command command, Tcl_Obj *objPtr);
-/* 518 */
-EXTERN int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
-				Tcl_Obj *fileName, const char *encodingName);
-/* 519 */
-EXTERN Tcl_ExitProc *	Tcl_SetExitProc(Tcl_ExitProc *proc);
-/* 520 */
-EXTERN void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
-				Tcl_LimitHandlerProc *handlerProc,
-				ClientData clientData,
-				Tcl_LimitHandlerDeleteProc *deleteProc);
-/* 521 */
-EXTERN void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
-				Tcl_LimitHandlerProc *handlerProc,
-				ClientData clientData);
-/* 522 */
-EXTERN int		Tcl_LimitReady(Tcl_Interp *interp);
-/* 523 */
-EXTERN int		Tcl_LimitCheck(Tcl_Interp *interp);
-/* 524 */
-EXTERN int		Tcl_LimitExceeded(Tcl_Interp *interp);
-/* 525 */
-EXTERN void		Tcl_LimitSetCommands(Tcl_Interp *interp,
-				int commandLimit);
-/* 526 */
-EXTERN void		Tcl_LimitSetTime(Tcl_Interp *interp,
-				Tcl_Time *timeLimitPtr);
-/* 527 */
-EXTERN void		Tcl_LimitSetGranularity(Tcl_Interp *interp, int type,
-				int granularity);
-/* 528 */
-EXTERN int		Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type);
-/* 529 */
-EXTERN int		Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type);
-/* 530 */
-EXTERN void		Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
-/* 531 */
-EXTERN void		Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
-/* 532 */
-EXTERN int		Tcl_LimitGetCommands(Tcl_Interp *interp);
-/* 533 */
-EXTERN void		Tcl_LimitGetTime(Tcl_Interp *interp,
-				Tcl_Time *timeLimitPtr);
-/* 534 */
-EXTERN int		Tcl_LimitGetGranularity(Tcl_Interp *interp, int type);
-/* 535 */
-EXTERN Tcl_InterpState	Tcl_SaveInterpState(Tcl_Interp *interp, int status);
-/* 536 */
-EXTERN int		Tcl_RestoreInterpState(Tcl_Interp *interp,
-				Tcl_InterpState state);
-/* 537 */
-EXTERN void		Tcl_DiscardInterpState(Tcl_InterpState state);
-/* 538 */
-EXTERN int		Tcl_SetReturnOptions(Tcl_Interp *interp,
-				Tcl_Obj *options);
-/* 539 */
-EXTERN Tcl_Obj *	Tcl_GetReturnOptions(Tcl_Interp *interp, int result);
-/* 540 */
-EXTERN int		Tcl_IsEnsemble(Tcl_Command token);
-/* 541 */
-EXTERN Tcl_Command	Tcl_CreateEnsemble(Tcl_Interp *interp,
-				const char *name,
-				Tcl_Namespace *namespacePtr, int flags);
-/* 542 */
-EXTERN Tcl_Command	Tcl_FindEnsemble(Tcl_Interp *interp,
-				Tcl_Obj *cmdNameObj, int flags);
-/* 543 */
-EXTERN int		Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj *subcmdList);
-/* 544 */
-EXTERN int		Tcl_SetEnsembleMappingDict(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj *mapDict);
-/* 545 */
-EXTERN int		Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj *unknownList);
-/* 546 */
-EXTERN int		Tcl_SetEnsembleFlags(Tcl_Interp *interp,
-				Tcl_Command token, int flags);
-/* 547 */
-EXTERN int		Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj **subcmdListPtr);
-/* 548 */
-EXTERN int		Tcl_GetEnsembleMappingDict(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj **mapDictPtr);
-/* 549 */
-EXTERN int		Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj **unknownListPtr);
-/* 550 */
-EXTERN int		Tcl_GetEnsembleFlags(Tcl_Interp *interp,
-				Tcl_Command token, int *flagsPtr);
-/* 551 */
-EXTERN int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
-				Tcl_Command token,
-				Tcl_Namespace **namespacePtrPtr);
-/* 552 */
-EXTERN void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
-				Tcl_ScaleTimeProc *scaleProc,
-				ClientData clientData);
-/* 553 */
-EXTERN void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
-				Tcl_ScaleTimeProc **scaleProc,
-				ClientData *clientData);
+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 */
 /* 554 */
-EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
-				const Tcl_ChannelType *chanTypePtr);
-/* 555 */
-EXTERN Tcl_Obj *	Tcl_NewBignumObj(mp_int *value);
-/* 556 */
-EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(mp_int *value, const char *file,
-				int line);
-/* 557 */
-EXTERN void		Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value);
-/* 558 */
-EXTERN int		Tcl_GetBignumFromObj(Tcl_Interp *interp,
-				Tcl_Obj *obj, mp_int *value);
-/* 559 */
-EXTERN int		Tcl_TakeBignumFromObj(Tcl_Interp *interp,
-				Tcl_Obj *obj, mp_int *value);
-/* 560 */
-EXTERN int		Tcl_TruncateChannel(Tcl_Channel chan,
-				Tcl_WideInt length);
-/* 561 */
-EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
-				const Tcl_ChannelType *chanTypePtr);
-/* 562 */
-EXTERN void		Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
-				Tcl_Obj *msg);
-/* 563 */
-EXTERN void		Tcl_GetChannelErrorInterp(Tcl_Interp *interp,
-				Tcl_Obj **msg);
-/* 564 */
-EXTERN void		Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg);
-/* 565 */
-EXTERN void		Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg);
-/* 566 */
-EXTERN int		Tcl_InitBignumFromDouble(Tcl_Interp *interp,
-				double initval, mp_int *toInit);
-/* 567 */
-EXTERN Tcl_Obj *	Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr);
-/* 568 */
-EXTERN int		Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr);
-/* 569 */
-EXTERN int		Tcl_GetEncodingFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
-/* 570 */
-EXTERN Tcl_Obj *	Tcl_GetEncodingSearchPath(void);
-/* 571 */
-EXTERN int		Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath);
-/* 572 */
-EXTERN const char *	Tcl_GetEncodingNameFromEnvironment(
-				Tcl_DString *bufPtr);
+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 */
 /* 573 */
-EXTERN int		Tcl_PkgRequireProc(Tcl_Interp *interp,
-				const char *name, int objc,
-				Tcl_Obj *const objv[], void *clientDataPtr);
-/* 574 */
-EXTERN void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
-				Tcl_Obj *objPtr);
-/* 575 */
-EXTERN void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
-				const char *bytes, int length, int limit,
-				const char *ellipsis);
-/* 576 */
-EXTERN Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, const char *format,
-				int objc, Tcl_Obj *const objv[]);
-/* 577 */
-EXTERN int		Tcl_AppendFormatToObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, const char *format,
-				int objc, Tcl_Obj *const objv[]);
-/* 578 */
-EXTERN Tcl_Obj *	Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
-/* 579 */
-EXTERN void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
-				const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
-/* 580 */
-EXTERN int		Tcl_CancelEval(Tcl_Interp *interp,
-				Tcl_Obj *resultObjPtr, ClientData clientData,
-				int flags);
-/* 581 */
-EXTERN int		Tcl_Canceled(Tcl_Interp *interp, int flags);
-/* 582 */
-EXTERN int		Tcl_CreatePipe(Tcl_Interp *interp,
-				Tcl_Channel *rchan, Tcl_Channel *wchan,
-				int flags);
-/* 583 */
-EXTERN Tcl_Command	Tcl_NRCreateCommand(Tcl_Interp *interp,
-				const char *cmdName, Tcl_ObjCmdProc *proc,
-				Tcl_ObjCmdProc *nreProc,
-				ClientData clientData,
-				Tcl_CmdDeleteProc *deleteProc);
-/* 584 */
-EXTERN int		Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags);
-/* 585 */
-EXTERN int		Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[], int flags);
-/* 586 */
-EXTERN int		Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd,
-				int objc, Tcl_Obj *const objv[], int flags);
-/* 587 */
-EXTERN void		Tcl_NRAddCallback(Tcl_Interp *interp,
-				Tcl_NRPostProc *postProcPtr,
-				ClientData data0, ClientData data1,
-				ClientData data2, ClientData data3);
-/* 588 */
-EXTERN int		Tcl_NRCallObjProc(Tcl_Interp *interp,
-				Tcl_ObjCmdProc *objProc,
-				ClientData clientData, int objc,
-				Tcl_Obj *const objv[]);
-/* 589 */
-EXTERN unsigned		Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
-/* 590 */
-EXTERN unsigned		Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
-/* 591 */
-EXTERN unsigned		Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
-/* 592 */
-EXTERN int		Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr);
-/* 593 */
-EXTERN int		Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr);
-/* 594 */
-EXTERN int		Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr);
-/* 595 */
-EXTERN int		Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr);
-/* 596 */
-EXTERN Tcl_WideInt	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
-/* 597 */
-EXTERN Tcl_WideInt	Tcl_GetModificationTimeFromStat(
-				const Tcl_StatBuf *statPtr);
-/* 598 */
-EXTERN Tcl_WideInt	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
-/* 599 */
-EXTERN Tcl_WideUInt	Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
-/* 600 */
-EXTERN Tcl_WideUInt	Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
-/* 601 */
-EXTERN unsigned		Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr);
-/* 602 */
-EXTERN int		Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj *paramList);
-/* 603 */
-EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
-				Tcl_Command token, Tcl_Obj **paramListPtr);
-/* 604 */
-EXTERN int		Tcl_ParseArgsObjv(Tcl_Interp *interp,
-				const Tcl_ArgvInfo *argTable, int *objcPtr,
-				Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
-/* 605 */
-EXTERN int		Tcl_GetErrorLine(Tcl_Interp *interp);
-/* 606 */
-EXTERN void		Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum);
-/* 607 */
-EXTERN void		Tcl_TransferResult(Tcl_Interp *sourceInterp,
-				int result, Tcl_Interp *targetInterp);
-/* 608 */
-EXTERN int		Tcl_InterpActive(Tcl_Interp *interp);
-/* 609 */
-EXTERN void		Tcl_BackgroundException(Tcl_Interp *interp, int code);
-/* 610 */
-EXTERN int		Tcl_ZlibDeflate(Tcl_Interp *interp, int format,
-				Tcl_Obj *data, int level,
-				Tcl_Obj *gzipHeaderDictObj);
-/* 611 */
-EXTERN int		Tcl_ZlibInflate(Tcl_Interp *interp, int format,
-				Tcl_Obj *data, int buffersize,
-				Tcl_Obj *gzipHeaderDictObj);
-/* 612 */
-EXTERN unsigned int	Tcl_ZlibCRC32(unsigned int crc,
-				const unsigned char *buf, int len);
-/* 613 */
-EXTERN unsigned int	Tcl_ZlibAdler32(unsigned int adler,
-				const unsigned char *buf, int len);
-/* 614 */
-EXTERN int		Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
-				int format, int level, Tcl_Obj *dictObj,
-				Tcl_ZlibStream *zshandle);
-/* 615 */
-EXTERN Tcl_Obj *	Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle);
-/* 616 */
-EXTERN int		Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle);
-/* 617 */
-EXTERN int		Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle);
-/* 618 */
-EXTERN int		Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle,
-				Tcl_Obj *data, int flush);
-/* 619 */
-EXTERN int		Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
-				Tcl_Obj *data, int count);
-/* 620 */
-EXTERN int		Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
-/* 621 */
-EXTERN int		Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
-/* 622 */
-EXTERN void		Tcl_SetStartupScript(Tcl_Obj *path,
-				const char *encoding);
-/* 623 */
-EXTERN Tcl_Obj *	Tcl_GetStartupScript(const char **encodingPtr);
-/* 624 */
-EXTERN int		Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan,
-				int flags);
-/* 625 */
-EXTERN int		Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				Tcl_Obj *resultPtr);
-/* 626 */
-EXTERN int		Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags);
-/* 627 */
-EXTERN int		Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-				const char *const symv[], int flags,
-				void *procPtrs, Tcl_LoadHandle *handlePtr);
-/* 628 */
-EXTERN void *		Tcl_FindSymbol(Tcl_Interp *interp,
-				Tcl_LoadHandle handle, const char *symbol);
-/* 629 */
-EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
-				Tcl_LoadHandle handlePtr);
+EXTERN int		Tcl_PkgRequireProc _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, int objc,
+				Tcl_Obj *CONST objv[],
+				ClientData *clientDataPtr));
 
 typedef struct TclStubHooks {
-    const struct TclPlatStubs *tclPlatStubs;
-    const struct TclIntStubs *tclIntStubs;
-    const struct TclIntPlatStubs *tclIntPlatStubs;
+    struct TclPlatStubs *tclPlatStubs;
+    struct TclIntStubs *tclIntStubs;
+    struct TclIntPlatStubs *tclIntPlatStubs;
 } TclStubHooks;
 
 typedef struct TclStubs {
     int magic;
-    const struct TclStubHooks *hooks;
+    struct TclStubHooks *hooks;
 
-    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
-    CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
-    void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 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) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
+    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_(TCL_VARARGS(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 */
+    int (*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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    void (*tcl_CreateFileHandler) _ANSI_ARGS_((int fd, int mask, Tcl_FileProc *proc, ClientData clientData)); /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    VOID *reserved9;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved9;
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    void (*tcl_DeleteFileHandler) _ANSI_ARGS_((int fd)); /* 10 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    void (*reserved9)(void);
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    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) (int fd); /* 10 */
+#ifdef __WIN32__
+    VOID *reserved10;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved10;
+#endif /* MAC_TCL */
+    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_VARARGS(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_VARARGS(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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid *pidPtr)); /* 111 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    void (*reserved10)(void);
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
-#endif /* MACOSX */
-    void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */
-    void (*tcl_Sleep) (int ms); /* 12 */
-    int (*tcl_WaitForEvent) (const 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, const 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 *const *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 */
-    CONST86 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) (const 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 */
-    CONST86 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) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
+#ifdef __WIN32__
+    void (*tcl_DetachPids) _ANSI_ARGS_((int numPids, Tcl_Pid *pidPtr)); /* 111 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved111;
+#endif /* MAC_TCL */
+    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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr)); /* 167 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    void (*reserved167)(void);
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
-#endif /* MACOSX */
-    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)(void);
-    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) (const 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) (const 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, void *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, const 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);
-    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, const 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 void *key); /* 421 */
-    Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
-    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const 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 *CONST86 * (*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, const 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) (const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */
-    const void * (*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, const Tcl_Filesystem *fsPtr); /* 473 */
-    int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
-    ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
-    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
-    CONST86 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) (const 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, const 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[], void *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, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */
-    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */
-    int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 580 */
-    int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */
-    int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */
-    Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */
-    int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */
-    int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */
-    int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */
-    void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 587 */
-    int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 588 */
-    unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */
-    unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */
-    unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */
-    int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */
-    int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */
-    int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */
-    int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */
-    Tcl_WideInt (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
-    Tcl_WideInt (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
-    Tcl_WideInt (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
-    Tcl_WideUInt (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
-    Tcl_WideUInt (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */
-    unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
-    int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
-    int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
-    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
-    int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
-    void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
-    void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 607 */
-    int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
-    void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
-    int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
-    int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */
-    unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, int len); /* 612 */
-    unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, int len); /* 613 */
-    int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */
-    Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */
-    int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */
-    int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */
-    int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */
-    int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 619 */
-    int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */
-    int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */
-    void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */
-    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */
-    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
-    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
-    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
-    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
-    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
-    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
+#ifdef __WIN32__
+    VOID *reserved167;
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved167;
+#endif /* MAC_TCL */
+    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 */
+    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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)); /* 197 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    Tcl_Channel (*tcl_OpenCommandChannel) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)); /* 197 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved197;
+#endif /* MAC_TCL */
+    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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    void (*tcl_ReapDetachedProcs) _ANSI_ARGS_((void)); /* 207 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved207;
+#endif /* MAC_TCL */
+    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_VARARGS(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_VARARGS(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 */
+    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 */
 } TclStubs;
 
 #ifdef __cplusplus
 extern "C" {
 #endif
-extern const TclStubs *tclStubsPtr;
+extern TclStubs *tclStubsPtr;
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS)
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
 
 /*
  * Inline function declarations:
  */
 
+#ifndef Tcl_PkgProvideEx
 #define Tcl_PkgProvideEx \
 	(tclStubsPtr->tcl_PkgProvideEx) /* 0 */
+#endif
+#ifndef Tcl_PkgRequireEx
 #define Tcl_PkgRequireEx \
 	(tclStubsPtr->tcl_PkgRequireEx) /* 1 */
+#endif
+#ifndef Tcl_Panic
 #define Tcl_Panic \
 	(tclStubsPtr->tcl_Panic) /* 2 */
+#endif
+#ifndef Tcl_Alloc
 #define Tcl_Alloc \
 	(tclStubsPtr->tcl_Alloc) /* 3 */
+#endif
+#ifndef Tcl_Free
 #define Tcl_Free \
 	(tclStubsPtr->tcl_Free) /* 4 */
+#endif
+#ifndef Tcl_Realloc
 #define Tcl_Realloc \
 	(tclStubsPtr->tcl_Realloc) /* 5 */
+#endif
+#ifndef Tcl_DbCkalloc
 #define Tcl_DbCkalloc \
 	(tclStubsPtr->tcl_DbCkalloc) /* 6 */
+#endif
+#ifndef Tcl_DbCkfree
 #define Tcl_DbCkfree \
 	(tclStubsPtr->tcl_DbCkfree) /* 7 */
+#endif
+#ifndef Tcl_DbCkrealloc
 #define Tcl_DbCkrealloc \
 	(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_CreateFileHandler
 #define Tcl_CreateFileHandler \
 	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
+#endif
 #endif /* UNIX */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#define Tcl_CreateFileHandler \
-	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
-#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_DeleteFileHandler
 #define Tcl_DeleteFileHandler \
 	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
+#endif
 #endif /* UNIX */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#define Tcl_DeleteFileHandler \
-	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
-#endif /* MACOSX */
+#ifndef Tcl_SetTimer
 #define Tcl_SetTimer \
 	(tclStubsPtr->tcl_SetTimer) /* 11 */
+#endif
+#ifndef Tcl_Sleep
 #define Tcl_Sleep \
 	(tclStubsPtr->tcl_Sleep) /* 12 */
+#endif
+#ifndef Tcl_WaitForEvent
 #define Tcl_WaitForEvent \
 	(tclStubsPtr->tcl_WaitForEvent) /* 13 */
+#endif
+#ifndef Tcl_AppendAllObjTypes
 #define Tcl_AppendAllObjTypes \
 	(tclStubsPtr->tcl_AppendAllObjTypes) /* 14 */
+#endif
+#ifndef Tcl_AppendStringsToObj
 #define Tcl_AppendStringsToObj \
 	(tclStubsPtr->tcl_AppendStringsToObj) /* 15 */
+#endif
+#ifndef Tcl_AppendToObj
 #define Tcl_AppendToObj \
 	(tclStubsPtr->tcl_AppendToObj) /* 16 */
+#endif
+#ifndef Tcl_ConcatObj
 #define Tcl_ConcatObj \
 	(tclStubsPtr->tcl_ConcatObj) /* 17 */
+#endif
+#ifndef Tcl_ConvertToType
 #define Tcl_ConvertToType \
 	(tclStubsPtr->tcl_ConvertToType) /* 18 */
+#endif
+#ifndef Tcl_DbDecrRefCount
 #define Tcl_DbDecrRefCount \
 	(tclStubsPtr->tcl_DbDecrRefCount) /* 19 */
+#endif
+#ifndef Tcl_DbIncrRefCount
 #define Tcl_DbIncrRefCount \
 	(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
+#endif
+#ifndef Tcl_DbIsShared
 #define Tcl_DbIsShared \
 	(tclStubsPtr->tcl_DbIsShared) /* 21 */
+#endif
+#ifndef Tcl_DbNewBooleanObj
 #define Tcl_DbNewBooleanObj \
 	(tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
+#endif
+#ifndef Tcl_DbNewByteArrayObj
 #define Tcl_DbNewByteArrayObj \
 	(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
+#endif
+#ifndef Tcl_DbNewDoubleObj
 #define Tcl_DbNewDoubleObj \
 	(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
+#endif
+#ifndef Tcl_DbNewListObj
 #define Tcl_DbNewListObj \
 	(tclStubsPtr->tcl_DbNewListObj) /* 25 */
+#endif
+#ifndef Tcl_DbNewLongObj
 #define Tcl_DbNewLongObj \
 	(tclStubsPtr->tcl_DbNewLongObj) /* 26 */
+#endif
+#ifndef Tcl_DbNewObj
 #define Tcl_DbNewObj \
 	(tclStubsPtr->tcl_DbNewObj) /* 27 */
+#endif
+#ifndef Tcl_DbNewStringObj
 #define Tcl_DbNewStringObj \
 	(tclStubsPtr->tcl_DbNewStringObj) /* 28 */
+#endif
+#ifndef Tcl_DuplicateObj
 #define Tcl_DuplicateObj \
 	(tclStubsPtr->tcl_DuplicateObj) /* 29 */
+#endif
+#ifndef TclFreeObj
 #define TclFreeObj \
 	(tclStubsPtr->tclFreeObj) /* 30 */
+#endif
+#ifndef Tcl_GetBoolean
 #define Tcl_GetBoolean \
 	(tclStubsPtr->tcl_GetBoolean) /* 31 */
+#endif
+#ifndef Tcl_GetBooleanFromObj
 #define Tcl_GetBooleanFromObj \
 	(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
+#endif
+#ifndef Tcl_GetByteArrayFromObj
 #define Tcl_GetByteArrayFromObj \
 	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
+#endif
+#ifndef Tcl_GetDouble
 #define Tcl_GetDouble \
 	(tclStubsPtr->tcl_GetDouble) /* 34 */
+#endif
+#ifndef Tcl_GetDoubleFromObj
 #define Tcl_GetDoubleFromObj \
 	(tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
+#endif
+#ifndef Tcl_GetIndexFromObj
 #define Tcl_GetIndexFromObj \
 	(tclStubsPtr->tcl_GetIndexFromObj) /* 36 */
+#endif
+#ifndef Tcl_GetInt
 #define Tcl_GetInt \
 	(tclStubsPtr->tcl_GetInt) /* 37 */
+#endif
+#ifndef Tcl_GetIntFromObj
 #define Tcl_GetIntFromObj \
 	(tclStubsPtr->tcl_GetIntFromObj) /* 38 */
+#endif
+#ifndef Tcl_GetLongFromObj
 #define Tcl_GetLongFromObj \
 	(tclStubsPtr->tcl_GetLongFromObj) /* 39 */
+#endif
+#ifndef Tcl_GetObjType
 #define Tcl_GetObjType \
 	(tclStubsPtr->tcl_GetObjType) /* 40 */
+#endif
+#ifndef Tcl_GetStringFromObj
 #define Tcl_GetStringFromObj \
 	(tclStubsPtr->tcl_GetStringFromObj) /* 41 */
+#endif
+#ifndef Tcl_InvalidateStringRep
 #define Tcl_InvalidateStringRep \
 	(tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
+#endif
+#ifndef Tcl_ListObjAppendList
 #define Tcl_ListObjAppendList \
 	(tclStubsPtr->tcl_ListObjAppendList) /* 43 */
+#endif
+#ifndef Tcl_ListObjAppendElement
 #define Tcl_ListObjAppendElement \
 	(tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
+#endif
+#ifndef Tcl_ListObjGetElements
 #define Tcl_ListObjGetElements \
 	(tclStubsPtr->tcl_ListObjGetElements) /* 45 */
+#endif
+#ifndef Tcl_ListObjIndex
 #define Tcl_ListObjIndex \
 	(tclStubsPtr->tcl_ListObjIndex) /* 46 */
+#endif
+#ifndef Tcl_ListObjLength
 #define Tcl_ListObjLength \
 	(tclStubsPtr->tcl_ListObjLength) /* 47 */
+#endif
+#ifndef Tcl_ListObjReplace
 #define Tcl_ListObjReplace \
 	(tclStubsPtr->tcl_ListObjReplace) /* 48 */
+#endif
+#ifndef Tcl_NewBooleanObj
 #define Tcl_NewBooleanObj \
 	(tclStubsPtr->tcl_NewBooleanObj) /* 49 */
+#endif
+#ifndef Tcl_NewByteArrayObj
 #define Tcl_NewByteArrayObj \
 	(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
+#endif
+#ifndef Tcl_NewDoubleObj
 #define Tcl_NewDoubleObj \
 	(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
+#endif
+#ifndef Tcl_NewIntObj
 #define Tcl_NewIntObj \
 	(tclStubsPtr->tcl_NewIntObj) /* 52 */
+#endif
+#ifndef Tcl_NewListObj
 #define Tcl_NewListObj \
 	(tclStubsPtr->tcl_NewListObj) /* 53 */
+#endif
+#ifndef Tcl_NewLongObj
 #define Tcl_NewLongObj \
 	(tclStubsPtr->tcl_NewLongObj) /* 54 */
+#endif
+#ifndef Tcl_NewObj
 #define Tcl_NewObj \
 	(tclStubsPtr->tcl_NewObj) /* 55 */
+#endif
+#ifndef Tcl_NewStringObj
 #define Tcl_NewStringObj \
 	(tclStubsPtr->tcl_NewStringObj) /* 56 */
+#endif
+#ifndef Tcl_SetBooleanObj
 #define Tcl_SetBooleanObj \
 	(tclStubsPtr->tcl_SetBooleanObj) /* 57 */
+#endif
+#ifndef Tcl_SetByteArrayLength
 #define Tcl_SetByteArrayLength \
 	(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
+#endif
+#ifndef Tcl_SetByteArrayObj
 #define Tcl_SetByteArrayObj \
 	(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
+#endif
+#ifndef Tcl_SetDoubleObj
 #define Tcl_SetDoubleObj \
 	(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
+#endif
+#ifndef Tcl_SetIntObj
 #define Tcl_SetIntObj \
 	(tclStubsPtr->tcl_SetIntObj) /* 61 */
+#endif
+#ifndef Tcl_SetListObj
 #define Tcl_SetListObj \
 	(tclStubsPtr->tcl_SetListObj) /* 62 */
+#endif
+#ifndef Tcl_SetLongObj
 #define Tcl_SetLongObj \
 	(tclStubsPtr->tcl_SetLongObj) /* 63 */
+#endif
+#ifndef Tcl_SetObjLength
 #define Tcl_SetObjLength \
 	(tclStubsPtr->tcl_SetObjLength) /* 64 */
+#endif
+#ifndef Tcl_SetStringObj
 #define Tcl_SetStringObj \
 	(tclStubsPtr->tcl_SetStringObj) /* 65 */
+#endif
+#ifndef Tcl_AddErrorInfo
 #define Tcl_AddErrorInfo \
 	(tclStubsPtr->tcl_AddErrorInfo) /* 66 */
+#endif
+#ifndef Tcl_AddObjErrorInfo
 #define Tcl_AddObjErrorInfo \
 	(tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
+#endif
+#ifndef Tcl_AllowExceptions
 #define Tcl_AllowExceptions \
 	(tclStubsPtr->tcl_AllowExceptions) /* 68 */
+#endif
+#ifndef Tcl_AppendElement
 #define Tcl_AppendElement \
 	(tclStubsPtr->tcl_AppendElement) /* 69 */
+#endif
+#ifndef Tcl_AppendResult
 #define Tcl_AppendResult \
 	(tclStubsPtr->tcl_AppendResult) /* 70 */
+#endif
+#ifndef Tcl_AsyncCreate
 #define Tcl_AsyncCreate \
 	(tclStubsPtr->tcl_AsyncCreate) /* 71 */
+#endif
+#ifndef Tcl_AsyncDelete
 #define Tcl_AsyncDelete \
 	(tclStubsPtr->tcl_AsyncDelete) /* 72 */
+#endif
+#ifndef Tcl_AsyncInvoke
 #define Tcl_AsyncInvoke \
 	(tclStubsPtr->tcl_AsyncInvoke) /* 73 */
+#endif
+#ifndef Tcl_AsyncMark
 #define Tcl_AsyncMark \
 	(tclStubsPtr->tcl_AsyncMark) /* 74 */
+#endif
+#ifndef Tcl_AsyncReady
 #define Tcl_AsyncReady \
 	(tclStubsPtr->tcl_AsyncReady) /* 75 */
+#endif
+#ifndef Tcl_BackgroundError
 #define Tcl_BackgroundError \
 	(tclStubsPtr->tcl_BackgroundError) /* 76 */
+#endif
+#ifndef Tcl_Backslash
 #define Tcl_Backslash \
 	(tclStubsPtr->tcl_Backslash) /* 77 */
+#endif
+#ifndef Tcl_BadChannelOption
 #define Tcl_BadChannelOption \
 	(tclStubsPtr->tcl_BadChannelOption) /* 78 */
+#endif
+#ifndef Tcl_CallWhenDeleted
 #define Tcl_CallWhenDeleted \
 	(tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
+#endif
+#ifndef Tcl_CancelIdleCall
 #define Tcl_CancelIdleCall \
 	(tclStubsPtr->tcl_CancelIdleCall) /* 80 */
+#endif
+#ifndef Tcl_Close
 #define Tcl_Close \
 	(tclStubsPtr->tcl_Close) /* 81 */
+#endif
+#ifndef Tcl_CommandComplete
 #define Tcl_CommandComplete \
 	(tclStubsPtr->tcl_CommandComplete) /* 82 */
+#endif
+#ifndef Tcl_Concat
 #define Tcl_Concat \
 	(tclStubsPtr->tcl_Concat) /* 83 */
+#endif
+#ifndef Tcl_ConvertElement
 #define Tcl_ConvertElement \
 	(tclStubsPtr->tcl_ConvertElement) /* 84 */
+#endif
+#ifndef Tcl_ConvertCountedElement
 #define Tcl_ConvertCountedElement \
 	(tclStubsPtr->tcl_ConvertCountedElement) /* 85 */
+#endif
+#ifndef Tcl_CreateAlias
 #define Tcl_CreateAlias \
 	(tclStubsPtr->tcl_CreateAlias) /* 86 */
+#endif
+#ifndef Tcl_CreateAliasObj
 #define Tcl_CreateAliasObj \
 	(tclStubsPtr->tcl_CreateAliasObj) /* 87 */
+#endif
+#ifndef Tcl_CreateChannel
 #define Tcl_CreateChannel \
 	(tclStubsPtr->tcl_CreateChannel) /* 88 */
+#endif
+#ifndef Tcl_CreateChannelHandler
 #define Tcl_CreateChannelHandler \
 	(tclStubsPtr->tcl_CreateChannelHandler) /* 89 */
+#endif
+#ifndef Tcl_CreateCloseHandler
 #define Tcl_CreateCloseHandler \
 	(tclStubsPtr->tcl_CreateCloseHandler) /* 90 */
+#endif
+#ifndef Tcl_CreateCommand
 #define Tcl_CreateCommand \
 	(tclStubsPtr->tcl_CreateCommand) /* 91 */
+#endif
+#ifndef Tcl_CreateEventSource
 #define Tcl_CreateEventSource \
 	(tclStubsPtr->tcl_CreateEventSource) /* 92 */
+#endif
+#ifndef Tcl_CreateExitHandler
 #define Tcl_CreateExitHandler \
 	(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
+#endif
+#ifndef Tcl_CreateInterp
 #define Tcl_CreateInterp \
 	(tclStubsPtr->tcl_CreateInterp) /* 94 */
+#endif
+#ifndef Tcl_CreateMathFunc
 #define Tcl_CreateMathFunc \
 	(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
+#endif
+#ifndef Tcl_CreateObjCommand
 #define Tcl_CreateObjCommand \
 	(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
+#endif
+#ifndef Tcl_CreateSlave
 #define Tcl_CreateSlave \
 	(tclStubsPtr->tcl_CreateSlave) /* 97 */
+#endif
+#ifndef Tcl_CreateTimerHandler
 #define Tcl_CreateTimerHandler \
 	(tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
+#endif
+#ifndef Tcl_CreateTrace
 #define Tcl_CreateTrace \
 	(tclStubsPtr->tcl_CreateTrace) /* 99 */
+#endif
+#ifndef Tcl_DeleteAssocData
 #define Tcl_DeleteAssocData \
 	(tclStubsPtr->tcl_DeleteAssocData) /* 100 */
+#endif
+#ifndef Tcl_DeleteChannelHandler
 #define Tcl_DeleteChannelHandler \
 	(tclStubsPtr->tcl_DeleteChannelHandler) /* 101 */
+#endif
+#ifndef Tcl_DeleteCloseHandler
 #define Tcl_DeleteCloseHandler \
 	(tclStubsPtr->tcl_DeleteCloseHandler) /* 102 */
+#endif
+#ifndef Tcl_DeleteCommand
 #define Tcl_DeleteCommand \
 	(tclStubsPtr->tcl_DeleteCommand) /* 103 */
+#endif
+#ifndef Tcl_DeleteCommandFromToken
 #define Tcl_DeleteCommandFromToken \
 	(tclStubsPtr->tcl_DeleteCommandFromToken) /* 104 */
+#endif
+#ifndef Tcl_DeleteEvents
 #define Tcl_DeleteEvents \
 	(tclStubsPtr->tcl_DeleteEvents) /* 105 */
+#endif
+#ifndef Tcl_DeleteEventSource
 #define Tcl_DeleteEventSource \
 	(tclStubsPtr->tcl_DeleteEventSource) /* 106 */
+#endif
+#ifndef Tcl_DeleteExitHandler
 #define Tcl_DeleteExitHandler \
 	(tclStubsPtr->tcl_DeleteExitHandler) /* 107 */
+#endif
+#ifndef Tcl_DeleteHashEntry
 #define Tcl_DeleteHashEntry \
 	(tclStubsPtr->tcl_DeleteHashEntry) /* 108 */
+#endif
+#ifndef Tcl_DeleteHashTable
 #define Tcl_DeleteHashTable \
 	(tclStubsPtr->tcl_DeleteHashTable) /* 109 */
+#endif
+#ifndef Tcl_DeleteInterp
 #define Tcl_DeleteInterp \
 	(tclStubsPtr->tcl_DeleteInterp) /* 110 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_DetachPids
 #define Tcl_DetachPids \
 	(tclStubsPtr->tcl_DetachPids) /* 111 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef Tcl_DetachPids
+#define Tcl_DetachPids \
+	(tclStubsPtr->tcl_DetachPids) /* 111 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_DeleteTimerHandler
 #define Tcl_DeleteTimerHandler \
 	(tclStubsPtr->tcl_DeleteTimerHandler) /* 112 */
+#endif
+#ifndef Tcl_DeleteTrace
 #define Tcl_DeleteTrace \
 	(tclStubsPtr->tcl_DeleteTrace) /* 113 */
+#endif
+#ifndef Tcl_DontCallWhenDeleted
 #define Tcl_DontCallWhenDeleted \
 	(tclStubsPtr->tcl_DontCallWhenDeleted) /* 114 */
+#endif
+#ifndef Tcl_DoOneEvent
 #define Tcl_DoOneEvent \
 	(tclStubsPtr->tcl_DoOneEvent) /* 115 */
+#endif
+#ifndef Tcl_DoWhenIdle
 #define Tcl_DoWhenIdle \
 	(tclStubsPtr->tcl_DoWhenIdle) /* 116 */
+#endif
+#ifndef Tcl_DStringAppend
 #define Tcl_DStringAppend \
 	(tclStubsPtr->tcl_DStringAppend) /* 117 */
+#endif
+#ifndef Tcl_DStringAppendElement
 #define Tcl_DStringAppendElement \
 	(tclStubsPtr->tcl_DStringAppendElement) /* 118 */
+#endif
+#ifndef Tcl_DStringEndSublist
 #define Tcl_DStringEndSublist \
 	(tclStubsPtr->tcl_DStringEndSublist) /* 119 */
+#endif
+#ifndef Tcl_DStringFree
 #define Tcl_DStringFree \
 	(tclStubsPtr->tcl_DStringFree) /* 120 */
+#endif
+#ifndef Tcl_DStringGetResult
 #define Tcl_DStringGetResult \
 	(tclStubsPtr->tcl_DStringGetResult) /* 121 */
+#endif
+#ifndef Tcl_DStringInit
 #define Tcl_DStringInit \
 	(tclStubsPtr->tcl_DStringInit) /* 122 */
+#endif
+#ifndef Tcl_DStringResult
 #define Tcl_DStringResult \
 	(tclStubsPtr->tcl_DStringResult) /* 123 */
+#endif
+#ifndef Tcl_DStringSetLength
 #define Tcl_DStringSetLength \
 	(tclStubsPtr->tcl_DStringSetLength) /* 124 */
+#endif
+#ifndef Tcl_DStringStartSublist
 #define Tcl_DStringStartSublist \
 	(tclStubsPtr->tcl_DStringStartSublist) /* 125 */
+#endif
+#ifndef Tcl_Eof
 #define Tcl_Eof \
 	(tclStubsPtr->tcl_Eof) /* 126 */
+#endif
+#ifndef Tcl_ErrnoId
 #define Tcl_ErrnoId \
 	(tclStubsPtr->tcl_ErrnoId) /* 127 */
+#endif
+#ifndef Tcl_ErrnoMsg
 #define Tcl_ErrnoMsg \
 	(tclStubsPtr->tcl_ErrnoMsg) /* 128 */
+#endif
+#ifndef Tcl_Eval
 #define Tcl_Eval \
 	(tclStubsPtr->tcl_Eval) /* 129 */
+#endif
+#ifndef Tcl_EvalFile
 #define Tcl_EvalFile \
 	(tclStubsPtr->tcl_EvalFile) /* 130 */
+#endif
+#ifndef Tcl_EvalObj
 #define Tcl_EvalObj \
 	(tclStubsPtr->tcl_EvalObj) /* 131 */
+#endif
+#ifndef Tcl_EventuallyFree
 #define Tcl_EventuallyFree \
 	(tclStubsPtr->tcl_EventuallyFree) /* 132 */
+#endif
+#ifndef Tcl_Exit
 #define Tcl_Exit \
 	(tclStubsPtr->tcl_Exit) /* 133 */
+#endif
+#ifndef Tcl_ExposeCommand
 #define Tcl_ExposeCommand \
 	(tclStubsPtr->tcl_ExposeCommand) /* 134 */
+#endif
+#ifndef Tcl_ExprBoolean
 #define Tcl_ExprBoolean \
 	(tclStubsPtr->tcl_ExprBoolean) /* 135 */
+#endif
+#ifndef Tcl_ExprBooleanObj
 #define Tcl_ExprBooleanObj \
 	(tclStubsPtr->tcl_ExprBooleanObj) /* 136 */
+#endif
+#ifndef Tcl_ExprDouble
 #define Tcl_ExprDouble \
 	(tclStubsPtr->tcl_ExprDouble) /* 137 */
+#endif
+#ifndef Tcl_ExprDoubleObj
 #define Tcl_ExprDoubleObj \
 	(tclStubsPtr->tcl_ExprDoubleObj) /* 138 */
+#endif
+#ifndef Tcl_ExprLong
 #define Tcl_ExprLong \
 	(tclStubsPtr->tcl_ExprLong) /* 139 */
+#endif
+#ifndef Tcl_ExprLongObj
 #define Tcl_ExprLongObj \
 	(tclStubsPtr->tcl_ExprLongObj) /* 140 */
+#endif
+#ifndef Tcl_ExprObj
 #define Tcl_ExprObj \
 	(tclStubsPtr->tcl_ExprObj) /* 141 */
+#endif
+#ifndef Tcl_ExprString
 #define Tcl_ExprString \
 	(tclStubsPtr->tcl_ExprString) /* 142 */
+#endif
+#ifndef Tcl_Finalize
 #define Tcl_Finalize \
 	(tclStubsPtr->tcl_Finalize) /* 143 */
+#endif
+#ifndef Tcl_FindExecutable
 #define Tcl_FindExecutable \
 	(tclStubsPtr->tcl_FindExecutable) /* 144 */
+#endif
+#ifndef Tcl_FirstHashEntry
 #define Tcl_FirstHashEntry \
 	(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
+#endif
+#ifndef Tcl_Flush
 #define Tcl_Flush \
 	(tclStubsPtr->tcl_Flush) /* 146 */
+#endif
+#ifndef Tcl_FreeResult
 #define Tcl_FreeResult \
 	(tclStubsPtr->tcl_FreeResult) /* 147 */
+#endif
+#ifndef Tcl_GetAlias
 #define Tcl_GetAlias \
 	(tclStubsPtr->tcl_GetAlias) /* 148 */
+#endif
+#ifndef Tcl_GetAliasObj
 #define Tcl_GetAliasObj \
 	(tclStubsPtr->tcl_GetAliasObj) /* 149 */
+#endif
+#ifndef Tcl_GetAssocData
 #define Tcl_GetAssocData \
 	(tclStubsPtr->tcl_GetAssocData) /* 150 */
+#endif
+#ifndef Tcl_GetChannel
 #define Tcl_GetChannel \
 	(tclStubsPtr->tcl_GetChannel) /* 151 */
+#endif
+#ifndef Tcl_GetChannelBufferSize
 #define Tcl_GetChannelBufferSize \
 	(tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */
+#endif
+#ifndef Tcl_GetChannelHandle
 #define Tcl_GetChannelHandle \
 	(tclStubsPtr->tcl_GetChannelHandle) /* 153 */
+#endif
+#ifndef Tcl_GetChannelInstanceData
 #define Tcl_GetChannelInstanceData \
 	(tclStubsPtr->tcl_GetChannelInstanceData) /* 154 */
+#endif
+#ifndef Tcl_GetChannelMode
 #define Tcl_GetChannelMode \
 	(tclStubsPtr->tcl_GetChannelMode) /* 155 */
+#endif
+#ifndef Tcl_GetChannelName
 #define Tcl_GetChannelName \
 	(tclStubsPtr->tcl_GetChannelName) /* 156 */
+#endif
+#ifndef Tcl_GetChannelOption
 #define Tcl_GetChannelOption \
 	(tclStubsPtr->tcl_GetChannelOption) /* 157 */
+#endif
+#ifndef Tcl_GetChannelType
 #define Tcl_GetChannelType \
 	(tclStubsPtr->tcl_GetChannelType) /* 158 */
+#endif
+#ifndef Tcl_GetCommandInfo
 #define Tcl_GetCommandInfo \
 	(tclStubsPtr->tcl_GetCommandInfo) /* 159 */
+#endif
+#ifndef Tcl_GetCommandName
 #define Tcl_GetCommandName \
 	(tclStubsPtr->tcl_GetCommandName) /* 160 */
+#endif
+#ifndef Tcl_GetErrno
 #define Tcl_GetErrno \
 	(tclStubsPtr->tcl_GetErrno) /* 161 */
+#endif
+#ifndef Tcl_GetHostName
 #define Tcl_GetHostName \
 	(tclStubsPtr->tcl_GetHostName) /* 162 */
+#endif
+#ifndef Tcl_GetInterpPath
 #define Tcl_GetInterpPath \
 	(tclStubsPtr->tcl_GetInterpPath) /* 163 */
+#endif
+#ifndef Tcl_GetMaster
 #define Tcl_GetMaster \
 	(tclStubsPtr->tcl_GetMaster) /* 164 */
+#endif
+#ifndef Tcl_GetNameOfExecutable
 #define Tcl_GetNameOfExecutable \
 	(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
+#endif
+#ifndef Tcl_GetObjResult
 #define Tcl_GetObjResult \
 	(tclStubsPtr->tcl_GetObjResult) /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_GetOpenFile
 #define Tcl_GetOpenFile \
 	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
+#endif
 #endif /* UNIX */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#define Tcl_GetOpenFile \
-	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
-#endif /* MACOSX */
+#ifndef Tcl_GetPathType
 #define Tcl_GetPathType \
 	(tclStubsPtr->tcl_GetPathType) /* 168 */
+#endif
+#ifndef Tcl_Gets
 #define Tcl_Gets \
 	(tclStubsPtr->tcl_Gets) /* 169 */
+#endif
+#ifndef Tcl_GetsObj
 #define Tcl_GetsObj \
 	(tclStubsPtr->tcl_GetsObj) /* 170 */
+#endif
+#ifndef Tcl_GetServiceMode
 #define Tcl_GetServiceMode \
 	(tclStubsPtr->tcl_GetServiceMode) /* 171 */
+#endif
+#ifndef Tcl_GetSlave
 #define Tcl_GetSlave \
 	(tclStubsPtr->tcl_GetSlave) /* 172 */
+#endif
+#ifndef Tcl_GetStdChannel
 #define Tcl_GetStdChannel \
 	(tclStubsPtr->tcl_GetStdChannel) /* 173 */
+#endif
+#ifndef Tcl_GetStringResult
 #define Tcl_GetStringResult \
 	(tclStubsPtr->tcl_GetStringResult) /* 174 */
+#endif
+#ifndef Tcl_GetVar
 #define Tcl_GetVar \
 	(tclStubsPtr->tcl_GetVar) /* 175 */
+#endif
+#ifndef Tcl_GetVar2
 #define Tcl_GetVar2 \
 	(tclStubsPtr->tcl_GetVar2) /* 176 */
+#endif
+#ifndef Tcl_GlobalEval
 #define Tcl_GlobalEval \
 	(tclStubsPtr->tcl_GlobalEval) /* 177 */
+#endif
+#ifndef Tcl_GlobalEvalObj
 #define Tcl_GlobalEvalObj \
 	(tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
+#endif
+#ifndef Tcl_HideCommand
 #define Tcl_HideCommand \
 	(tclStubsPtr->tcl_HideCommand) /* 179 */
+#endif
+#ifndef Tcl_Init
 #define Tcl_Init \
 	(tclStubsPtr->tcl_Init) /* 180 */
+#endif
+#ifndef Tcl_InitHashTable
 #define Tcl_InitHashTable \
 	(tclStubsPtr->tcl_InitHashTable) /* 181 */
+#endif
+#ifndef Tcl_InputBlocked
 #define Tcl_InputBlocked \
 	(tclStubsPtr->tcl_InputBlocked) /* 182 */
+#endif
+#ifndef Tcl_InputBuffered
 #define Tcl_InputBuffered \
 	(tclStubsPtr->tcl_InputBuffered) /* 183 */
+#endif
+#ifndef Tcl_InterpDeleted
 #define Tcl_InterpDeleted \
 	(tclStubsPtr->tcl_InterpDeleted) /* 184 */
+#endif
+#ifndef Tcl_IsSafe
 #define Tcl_IsSafe \
 	(tclStubsPtr->tcl_IsSafe) /* 185 */
+#endif
+#ifndef Tcl_JoinPath
 #define Tcl_JoinPath \
 	(tclStubsPtr->tcl_JoinPath) /* 186 */
+#endif
+#ifndef Tcl_LinkVar
 #define Tcl_LinkVar \
 	(tclStubsPtr->tcl_LinkVar) /* 187 */
+#endif
 /* Slot 188 is reserved */
+#ifndef Tcl_MakeFileChannel
 #define Tcl_MakeFileChannel \
 	(tclStubsPtr->tcl_MakeFileChannel) /* 189 */
+#endif
+#ifndef Tcl_MakeSafe
 #define Tcl_MakeSafe \
 	(tclStubsPtr->tcl_MakeSafe) /* 190 */
+#endif
+#ifndef Tcl_MakeTcpClientChannel
 #define Tcl_MakeTcpClientChannel \
 	(tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */
+#endif
+#ifndef Tcl_Merge
 #define Tcl_Merge \
 	(tclStubsPtr->tcl_Merge) /* 192 */
+#endif
+#ifndef Tcl_NextHashEntry
 #define Tcl_NextHashEntry \
 	(tclStubsPtr->tcl_NextHashEntry) /* 193 */
+#endif
+#ifndef Tcl_NotifyChannel
 #define Tcl_NotifyChannel \
 	(tclStubsPtr->tcl_NotifyChannel) /* 194 */
+#endif
+#ifndef Tcl_ObjGetVar2
 #define Tcl_ObjGetVar2 \
 	(tclStubsPtr->tcl_ObjGetVar2) /* 195 */
+#endif
+#ifndef Tcl_ObjSetVar2
 #define Tcl_ObjSetVar2 \
 	(tclStubsPtr->tcl_ObjSetVar2) /* 196 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_OpenCommandChannel
 #define Tcl_OpenCommandChannel \
 	(tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef Tcl_OpenCommandChannel
+#define Tcl_OpenCommandChannel \
+	(tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_OpenFileChannel
 #define Tcl_OpenFileChannel \
 	(tclStubsPtr->tcl_OpenFileChannel) /* 198 */
+#endif
+#ifndef Tcl_OpenTcpClient
 #define Tcl_OpenTcpClient \
 	(tclStubsPtr->tcl_OpenTcpClient) /* 199 */
+#endif
+#ifndef Tcl_OpenTcpServer
 #define Tcl_OpenTcpServer \
 	(tclStubsPtr->tcl_OpenTcpServer) /* 200 */
+#endif
+#ifndef Tcl_Preserve
 #define Tcl_Preserve \
 	(tclStubsPtr->tcl_Preserve) /* 201 */
+#endif
+#ifndef Tcl_PrintDouble
 #define Tcl_PrintDouble \
 	(tclStubsPtr->tcl_PrintDouble) /* 202 */
+#endif
+#ifndef Tcl_PutEnv
 #define Tcl_PutEnv \
 	(tclStubsPtr->tcl_PutEnv) /* 203 */
+#endif
+#ifndef Tcl_PosixError
 #define Tcl_PosixError \
 	(tclStubsPtr->tcl_PosixError) /* 204 */
+#endif
+#ifndef Tcl_QueueEvent
 #define Tcl_QueueEvent \
 	(tclStubsPtr->tcl_QueueEvent) /* 205 */
+#endif
+#ifndef Tcl_Read
 #define Tcl_Read \
 	(tclStubsPtr->tcl_Read) /* 206 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_ReapDetachedProcs
 #define Tcl_ReapDetachedProcs \
 	(tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef Tcl_ReapDetachedProcs
+#define Tcl_ReapDetachedProcs \
+	(tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_RecordAndEval
 #define Tcl_RecordAndEval \
 	(tclStubsPtr->tcl_RecordAndEval) /* 208 */
+#endif
+#ifndef Tcl_RecordAndEvalObj
 #define Tcl_RecordAndEvalObj \
 	(tclStubsPtr->tcl_RecordAndEvalObj) /* 209 */
+#endif
+#ifndef Tcl_RegisterChannel
 #define Tcl_RegisterChannel \
 	(tclStubsPtr->tcl_RegisterChannel) /* 210 */
+#endif
+#ifndef Tcl_RegisterObjType
 #define Tcl_RegisterObjType \
 	(tclStubsPtr->tcl_RegisterObjType) /* 211 */
+#endif
+#ifndef Tcl_RegExpCompile
 #define Tcl_RegExpCompile \
 	(tclStubsPtr->tcl_RegExpCompile) /* 212 */
+#endif
+#ifndef Tcl_RegExpExec
 #define Tcl_RegExpExec \
 	(tclStubsPtr->tcl_RegExpExec) /* 213 */
+#endif
+#ifndef Tcl_RegExpMatch
 #define Tcl_RegExpMatch \
 	(tclStubsPtr->tcl_RegExpMatch) /* 214 */
+#endif
+#ifndef Tcl_RegExpRange
 #define Tcl_RegExpRange \
 	(tclStubsPtr->tcl_RegExpRange) /* 215 */
+#endif
+#ifndef Tcl_Release
 #define Tcl_Release \
 	(tclStubsPtr->tcl_Release) /* 216 */
+#endif
+#ifndef Tcl_ResetResult
 #define Tcl_ResetResult \
 	(tclStubsPtr->tcl_ResetResult) /* 217 */
+#endif
+#ifndef Tcl_ScanElement
 #define Tcl_ScanElement \
 	(tclStubsPtr->tcl_ScanElement) /* 218 */
+#endif
+#ifndef Tcl_ScanCountedElement
 #define Tcl_ScanCountedElement \
 	(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
+#endif
+#ifndef Tcl_SeekOld
 #define Tcl_SeekOld \
 	(tclStubsPtr->tcl_SeekOld) /* 220 */
+#endif
+#ifndef Tcl_ServiceAll
 #define Tcl_ServiceAll \
 	(tclStubsPtr->tcl_ServiceAll) /* 221 */
+#endif
+#ifndef Tcl_ServiceEvent
 #define Tcl_ServiceEvent \
 	(tclStubsPtr->tcl_ServiceEvent) /* 222 */
+#endif
+#ifndef Tcl_SetAssocData
 #define Tcl_SetAssocData \
 	(tclStubsPtr->tcl_SetAssocData) /* 223 */
+#endif
+#ifndef Tcl_SetChannelBufferSize
 #define Tcl_SetChannelBufferSize \
 	(tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */
+#endif
+#ifndef Tcl_SetChannelOption
 #define Tcl_SetChannelOption \
 	(tclStubsPtr->tcl_SetChannelOption) /* 225 */
+#endif
+#ifndef Tcl_SetCommandInfo
 #define Tcl_SetCommandInfo \
 	(tclStubsPtr->tcl_SetCommandInfo) /* 226 */
+#endif
+#ifndef Tcl_SetErrno
 #define Tcl_SetErrno \
 	(tclStubsPtr->tcl_SetErrno) /* 227 */
+#endif
+#ifndef Tcl_SetErrorCode
 #define Tcl_SetErrorCode \
 	(tclStubsPtr->tcl_SetErrorCode) /* 228 */
+#endif
+#ifndef Tcl_SetMaxBlockTime
 #define Tcl_SetMaxBlockTime \
 	(tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */
+#endif
+#ifndef Tcl_SetPanicProc
 #define Tcl_SetPanicProc \
 	(tclStubsPtr->tcl_SetPanicProc) /* 230 */
+#endif
+#ifndef Tcl_SetRecursionLimit
 #define Tcl_SetRecursionLimit \
 	(tclStubsPtr->tcl_SetRecursionLimit) /* 231 */
+#endif
+#ifndef Tcl_SetResult
 #define Tcl_SetResult \
 	(tclStubsPtr->tcl_SetResult) /* 232 */
+#endif
+#ifndef Tcl_SetServiceMode
 #define Tcl_SetServiceMode \
 	(tclStubsPtr->tcl_SetServiceMode) /* 233 */
+#endif
+#ifndef Tcl_SetObjErrorCode
 #define Tcl_SetObjErrorCode \
 	(tclStubsPtr->tcl_SetObjErrorCode) /* 234 */
+#endif
+#ifndef Tcl_SetObjResult
 #define Tcl_SetObjResult \
 	(tclStubsPtr->tcl_SetObjResult) /* 235 */
+#endif
+#ifndef Tcl_SetStdChannel
 #define Tcl_SetStdChannel \
 	(tclStubsPtr->tcl_SetStdChannel) /* 236 */
+#endif
+#ifndef Tcl_SetVar
 #define Tcl_SetVar \
 	(tclStubsPtr->tcl_SetVar) /* 237 */
+#endif
+#ifndef Tcl_SetVar2
 #define Tcl_SetVar2 \
 	(tclStubsPtr->tcl_SetVar2) /* 238 */
+#endif
+#ifndef Tcl_SignalId
 #define Tcl_SignalId \
 	(tclStubsPtr->tcl_SignalId) /* 239 */
+#endif
+#ifndef Tcl_SignalMsg
 #define Tcl_SignalMsg \
 	(tclStubsPtr->tcl_SignalMsg) /* 240 */
+#endif
+#ifndef Tcl_SourceRCFile
 #define Tcl_SourceRCFile \
 	(tclStubsPtr->tcl_SourceRCFile) /* 241 */
+#endif
+#ifndef Tcl_SplitList
 #define Tcl_SplitList \
 	(tclStubsPtr->tcl_SplitList) /* 242 */
+#endif
+#ifndef Tcl_SplitPath
 #define Tcl_SplitPath \
 	(tclStubsPtr->tcl_SplitPath) /* 243 */
+#endif
+#ifndef Tcl_StaticPackage
 #define Tcl_StaticPackage \
 	(tclStubsPtr->tcl_StaticPackage) /* 244 */
+#endif
+#ifndef Tcl_StringMatch
 #define Tcl_StringMatch \
 	(tclStubsPtr->tcl_StringMatch) /* 245 */
+#endif
+#ifndef Tcl_TellOld
 #define Tcl_TellOld \
 	(tclStubsPtr->tcl_TellOld) /* 246 */
+#endif
+#ifndef Tcl_TraceVar
 #define Tcl_TraceVar \
 	(tclStubsPtr->tcl_TraceVar) /* 247 */
+#endif
+#ifndef Tcl_TraceVar2
 #define Tcl_TraceVar2 \
 	(tclStubsPtr->tcl_TraceVar2) /* 248 */
+#endif
+#ifndef Tcl_TranslateFileName
 #define Tcl_TranslateFileName \
 	(tclStubsPtr->tcl_TranslateFileName) /* 249 */
+#endif
+#ifndef Tcl_Ungets
 #define Tcl_Ungets \
 	(tclStubsPtr->tcl_Ungets) /* 250 */
+#endif
+#ifndef Tcl_UnlinkVar
 #define Tcl_UnlinkVar \
 	(tclStubsPtr->tcl_UnlinkVar) /* 251 */
+#endif
+#ifndef Tcl_UnregisterChannel
 #define Tcl_UnregisterChannel \
 	(tclStubsPtr->tcl_UnregisterChannel) /* 252 */
+#endif
+#ifndef Tcl_UnsetVar
 #define Tcl_UnsetVar \
 	(tclStubsPtr->tcl_UnsetVar) /* 253 */
+#endif
+#ifndef Tcl_UnsetVar2
 #define Tcl_UnsetVar2 \
 	(tclStubsPtr->tcl_UnsetVar2) /* 254 */
+#endif
+#ifndef Tcl_UntraceVar
 #define Tcl_UntraceVar \
 	(tclStubsPtr->tcl_UntraceVar) /* 255 */
+#endif
+#ifndef Tcl_UntraceVar2
 #define Tcl_UntraceVar2 \
 	(tclStubsPtr->tcl_UntraceVar2) /* 256 */
+#endif
+#ifndef Tcl_UpdateLinkedVar
 #define Tcl_UpdateLinkedVar \
 	(tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
+#endif
+#ifndef Tcl_UpVar
 #define Tcl_UpVar \
 	(tclStubsPtr->tcl_UpVar) /* 258 */
+#endif
+#ifndef Tcl_UpVar2
 #define Tcl_UpVar2 \
 	(tclStubsPtr->tcl_UpVar2) /* 259 */
+#endif
+#ifndef Tcl_VarEval
 #define Tcl_VarEval \
 	(tclStubsPtr->tcl_VarEval) /* 260 */
+#endif
+#ifndef Tcl_VarTraceInfo
 #define Tcl_VarTraceInfo \
 	(tclStubsPtr->tcl_VarTraceInfo) /* 261 */
+#endif
+#ifndef Tcl_VarTraceInfo2
 #define Tcl_VarTraceInfo2 \
 	(tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
+#endif
+#ifndef Tcl_Write
 #define Tcl_Write \
 	(tclStubsPtr->tcl_Write) /* 263 */
+#endif
+#ifndef Tcl_WrongNumArgs
 #define Tcl_WrongNumArgs \
 	(tclStubsPtr->tcl_WrongNumArgs) /* 264 */
+#endif
+#ifndef Tcl_DumpActiveMemory
 #define Tcl_DumpActiveMemory \
 	(tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
+#endif
+#ifndef Tcl_ValidateAllMemory
 #define Tcl_ValidateAllMemory \
 	(tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
+#endif
+#ifndef Tcl_AppendResultVA
 #define Tcl_AppendResultVA \
 	(tclStubsPtr->tcl_AppendResultVA) /* 267 */
+#endif
+#ifndef Tcl_AppendStringsToObjVA
 #define Tcl_AppendStringsToObjVA \
 	(tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
+#endif
+#ifndef Tcl_HashStats
 #define Tcl_HashStats \
 	(tclStubsPtr->tcl_HashStats) /* 269 */
+#endif
+#ifndef Tcl_ParseVar
 #define Tcl_ParseVar \
 	(tclStubsPtr->tcl_ParseVar) /* 270 */
+#endif
+#ifndef Tcl_PkgPresent
 #define Tcl_PkgPresent \
 	(tclStubsPtr->tcl_PkgPresent) /* 271 */
+#endif
+#ifndef Tcl_PkgPresentEx
 #define Tcl_PkgPresentEx \
 	(tclStubsPtr->tcl_PkgPresentEx) /* 272 */
+#endif
+#ifndef Tcl_PkgProvide
 #define Tcl_PkgProvide \
 	(tclStubsPtr->tcl_PkgProvide) /* 273 */
+#endif
+#ifndef Tcl_PkgRequire
 #define Tcl_PkgRequire \
 	(tclStubsPtr->tcl_PkgRequire) /* 274 */
+#endif
+#ifndef Tcl_SetErrorCodeVA
 #define Tcl_SetErrorCodeVA \
 	(tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
+#endif
+#ifndef Tcl_VarEvalVA
 #define Tcl_VarEvalVA \
 	(tclStubsPtr->tcl_VarEvalVA) /* 276 */
+#endif
+#ifndef Tcl_WaitPid
 #define Tcl_WaitPid \
 	(tclStubsPtr->tcl_WaitPid) /* 277 */
+#endif
+#ifndef Tcl_PanicVA
 #define Tcl_PanicVA \
 	(tclStubsPtr->tcl_PanicVA) /* 278 */
+#endif
+#ifndef Tcl_GetVersion
 #define Tcl_GetVersion \
 	(tclStubsPtr->tcl_GetVersion) /* 279 */
+#endif
+#ifndef Tcl_InitMemory
 #define Tcl_InitMemory \
 	(tclStubsPtr->tcl_InitMemory) /* 280 */
+#endif
+#ifndef Tcl_StackChannel
 #define Tcl_StackChannel \
 	(tclStubsPtr->tcl_StackChannel) /* 281 */
+#endif
+#ifndef Tcl_UnstackChannel
 #define Tcl_UnstackChannel \
 	(tclStubsPtr->tcl_UnstackChannel) /* 282 */
+#endif
+#ifndef Tcl_GetStackedChannel
 #define Tcl_GetStackedChannel \
 	(tclStubsPtr->tcl_GetStackedChannel) /* 283 */
+#endif
+#ifndef Tcl_SetMainLoop
 #define Tcl_SetMainLoop \
 	(tclStubsPtr->tcl_SetMainLoop) /* 284 */
+#endif
 /* Slot 285 is reserved */
+#ifndef Tcl_AppendObjToObj
 #define Tcl_AppendObjToObj \
 	(tclStubsPtr->tcl_AppendObjToObj) /* 286 */
+#endif
+#ifndef Tcl_CreateEncoding
 #define Tcl_CreateEncoding \
 	(tclStubsPtr->tcl_CreateEncoding) /* 287 */
+#endif
+#ifndef Tcl_CreateThreadExitHandler
 #define Tcl_CreateThreadExitHandler \
 	(tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */
+#endif
+#ifndef Tcl_DeleteThreadExitHandler
 #define Tcl_DeleteThreadExitHandler \
 	(tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */
+#endif
+#ifndef Tcl_DiscardResult
 #define Tcl_DiscardResult \
 	(tclStubsPtr->tcl_DiscardResult) /* 290 */
+#endif
+#ifndef Tcl_EvalEx
 #define Tcl_EvalEx \
 	(tclStubsPtr->tcl_EvalEx) /* 291 */
+#endif
+#ifndef Tcl_EvalObjv
 #define Tcl_EvalObjv \
 	(tclStubsPtr->tcl_EvalObjv) /* 292 */
+#endif
+#ifndef Tcl_EvalObjEx
 #define Tcl_EvalObjEx \
 	(tclStubsPtr->tcl_EvalObjEx) /* 293 */
+#endif
+#ifndef Tcl_ExitThread
 #define Tcl_ExitThread \
 	(tclStubsPtr->tcl_ExitThread) /* 294 */
+#endif
+#ifndef Tcl_ExternalToUtf
 #define Tcl_ExternalToUtf \
 	(tclStubsPtr->tcl_ExternalToUtf) /* 295 */
+#endif
+#ifndef Tcl_ExternalToUtfDString
 #define Tcl_ExternalToUtfDString \
 	(tclStubsPtr->tcl_ExternalToUtfDString) /* 296 */
+#endif
+#ifndef Tcl_FinalizeThread
 #define Tcl_FinalizeThread \
 	(tclStubsPtr->tcl_FinalizeThread) /* 297 */
+#endif
+#ifndef Tcl_FinalizeNotifier
 #define Tcl_FinalizeNotifier \
 	(tclStubsPtr->tcl_FinalizeNotifier) /* 298 */
+#endif
+#ifndef Tcl_FreeEncoding
 #define Tcl_FreeEncoding \
 	(tclStubsPtr->tcl_FreeEncoding) /* 299 */
+#endif
+#ifndef Tcl_GetCurrentThread
 #define Tcl_GetCurrentThread \
 	(tclStubsPtr->tcl_GetCurrentThread) /* 300 */
+#endif
+#ifndef Tcl_GetEncoding
 #define Tcl_GetEncoding \
 	(tclStubsPtr->tcl_GetEncoding) /* 301 */
+#endif
+#ifndef Tcl_GetEncodingName
 #define Tcl_GetEncodingName \
 	(tclStubsPtr->tcl_GetEncodingName) /* 302 */
+#endif
+#ifndef Tcl_GetEncodingNames
 #define Tcl_GetEncodingNames \
 	(tclStubsPtr->tcl_GetEncodingNames) /* 303 */
+#endif
+#ifndef Tcl_GetIndexFromObjStruct
 #define Tcl_GetIndexFromObjStruct \
 	(tclStubsPtr->tcl_GetIndexFromObjStruct) /* 304 */
+#endif
+#ifndef Tcl_GetThreadData
 #define Tcl_GetThreadData \
 	(tclStubsPtr->tcl_GetThreadData) /* 305 */
+#endif
+#ifndef Tcl_GetVar2Ex
 #define Tcl_GetVar2Ex \
 	(tclStubsPtr->tcl_GetVar2Ex) /* 306 */
+#endif
+#ifndef Tcl_InitNotifier
 #define Tcl_InitNotifier \
 	(tclStubsPtr->tcl_InitNotifier) /* 307 */
+#endif
+#ifndef Tcl_MutexLock
 #define Tcl_MutexLock \
 	(tclStubsPtr->tcl_MutexLock) /* 308 */
+#endif
+#ifndef Tcl_MutexUnlock
 #define Tcl_MutexUnlock \
 	(tclStubsPtr->tcl_MutexUnlock) /* 309 */
+#endif
+#ifndef Tcl_ConditionNotify
 #define Tcl_ConditionNotify \
 	(tclStubsPtr->tcl_ConditionNotify) /* 310 */
+#endif
+#ifndef Tcl_ConditionWait
 #define Tcl_ConditionWait \
 	(tclStubsPtr->tcl_ConditionWait) /* 311 */
+#endif
+#ifndef Tcl_NumUtfChars
 #define Tcl_NumUtfChars \
 	(tclStubsPtr->tcl_NumUtfChars) /* 312 */
+#endif
+#ifndef Tcl_ReadChars
 #define Tcl_ReadChars \
 	(tclStubsPtr->tcl_ReadChars) /* 313 */
+#endif
+#ifndef Tcl_RestoreResult
 #define Tcl_RestoreResult \
 	(tclStubsPtr->tcl_RestoreResult) /* 314 */
+#endif
+#ifndef Tcl_SaveResult
 #define Tcl_SaveResult \
 	(tclStubsPtr->tcl_SaveResult) /* 315 */
+#endif
+#ifndef Tcl_SetSystemEncoding
 #define Tcl_SetSystemEncoding \
 	(tclStubsPtr->tcl_SetSystemEncoding) /* 316 */
+#endif
+#ifndef Tcl_SetVar2Ex
 #define Tcl_SetVar2Ex \
 	(tclStubsPtr->tcl_SetVar2Ex) /* 317 */
+#endif
+#ifndef Tcl_ThreadAlert
 #define Tcl_ThreadAlert \
 	(tclStubsPtr->tcl_ThreadAlert) /* 318 */
+#endif
+#ifndef Tcl_ThreadQueueEvent
 #define Tcl_ThreadQueueEvent \
 	(tclStubsPtr->tcl_ThreadQueueEvent) /* 319 */
+#endif
+#ifndef Tcl_UniCharAtIndex
 #define Tcl_UniCharAtIndex \
 	(tclStubsPtr->tcl_UniCharAtIndex) /* 320 */
+#endif
+#ifndef Tcl_UniCharToLower
 #define Tcl_UniCharToLower \
 	(tclStubsPtr->tcl_UniCharToLower) /* 321 */
+#endif
+#ifndef Tcl_UniCharToTitle
 #define Tcl_UniCharToTitle \
 	(tclStubsPtr->tcl_UniCharToTitle) /* 322 */
+#endif
+#ifndef Tcl_UniCharToUpper
 #define Tcl_UniCharToUpper \
 	(tclStubsPtr->tcl_UniCharToUpper) /* 323 */
+#endif
+#ifndef Tcl_UniCharToUtf
 #define Tcl_UniCharToUtf \
 	(tclStubsPtr->tcl_UniCharToUtf) /* 324 */
+#endif
+#ifndef Tcl_UtfAtIndex
 #define Tcl_UtfAtIndex \
 	(tclStubsPtr->tcl_UtfAtIndex) /* 325 */
+#endif
+#ifndef Tcl_UtfCharComplete
 #define Tcl_UtfCharComplete \
 	(tclStubsPtr->tcl_UtfCharComplete) /* 326 */
+#endif
+#ifndef Tcl_UtfBackslash
 #define Tcl_UtfBackslash \
 	(tclStubsPtr->tcl_UtfBackslash) /* 327 */
+#endif
+#ifndef Tcl_UtfFindFirst
 #define Tcl_UtfFindFirst \
 	(tclStubsPtr->tcl_UtfFindFirst) /* 328 */
+#endif
+#ifndef Tcl_UtfFindLast
 #define Tcl_UtfFindLast \
 	(tclStubsPtr->tcl_UtfFindLast) /* 329 */
+#endif
+#ifndef Tcl_UtfNext
 #define Tcl_UtfNext \
 	(tclStubsPtr->tcl_UtfNext) /* 330 */
+#endif
+#ifndef Tcl_UtfPrev
 #define Tcl_UtfPrev \
 	(tclStubsPtr->tcl_UtfPrev) /* 331 */
+#endif
+#ifndef Tcl_UtfToExternal
 #define Tcl_UtfToExternal \
 	(tclStubsPtr->tcl_UtfToExternal) /* 332 */
+#endif
+#ifndef Tcl_UtfToExternalDString
 #define Tcl_UtfToExternalDString \
 	(tclStubsPtr->tcl_UtfToExternalDString) /* 333 */
+#endif
+#ifndef Tcl_UtfToLower
 #define Tcl_UtfToLower \
 	(tclStubsPtr->tcl_UtfToLower) /* 334 */
+#endif
+#ifndef Tcl_UtfToTitle
 #define Tcl_UtfToTitle \
 	(tclStubsPtr->tcl_UtfToTitle) /* 335 */
+#endif
+#ifndef Tcl_UtfToUniChar
 #define Tcl_UtfToUniChar \
 	(tclStubsPtr->tcl_UtfToUniChar) /* 336 */
+#endif
+#ifndef Tcl_UtfToUpper
 #define Tcl_UtfToUpper \
 	(tclStubsPtr->tcl_UtfToUpper) /* 337 */
+#endif
+#ifndef Tcl_WriteChars
 #define Tcl_WriteChars \
 	(tclStubsPtr->tcl_WriteChars) /* 338 */
+#endif
+#ifndef Tcl_WriteObj
 #define Tcl_WriteObj \
 	(tclStubsPtr->tcl_WriteObj) /* 339 */
+#endif
+#ifndef Tcl_GetString
 #define Tcl_GetString \
 	(tclStubsPtr->tcl_GetString) /* 340 */
+#endif
+#ifndef Tcl_GetDefaultEncodingDir
 #define Tcl_GetDefaultEncodingDir \
 	(tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */
+#endif
+#ifndef Tcl_SetDefaultEncodingDir
 #define Tcl_SetDefaultEncodingDir \
 	(tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */
+#endif
+#ifndef Tcl_AlertNotifier
 #define Tcl_AlertNotifier \
 	(tclStubsPtr->tcl_AlertNotifier) /* 343 */
+#endif
+#ifndef Tcl_ServiceModeHook
 #define Tcl_ServiceModeHook \
 	(tclStubsPtr->tcl_ServiceModeHook) /* 344 */
+#endif
+#ifndef Tcl_UniCharIsAlnum
 #define Tcl_UniCharIsAlnum \
 	(tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */
+#endif
+#ifndef Tcl_UniCharIsAlpha
 #define Tcl_UniCharIsAlpha \
 	(tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */
+#endif
+#ifndef Tcl_UniCharIsDigit
 #define Tcl_UniCharIsDigit \
 	(tclStubsPtr->tcl_UniCharIsDigit) /* 347 */
+#endif
+#ifndef Tcl_UniCharIsLower
 #define Tcl_UniCharIsLower \
 	(tclStubsPtr->tcl_UniCharIsLower) /* 348 */
+#endif
+#ifndef Tcl_UniCharIsSpace
 #define Tcl_UniCharIsSpace \
 	(tclStubsPtr->tcl_UniCharIsSpace) /* 349 */
+#endif
+#ifndef Tcl_UniCharIsUpper
 #define Tcl_UniCharIsUpper \
 	(tclStubsPtr->tcl_UniCharIsUpper) /* 350 */
+#endif
+#ifndef Tcl_UniCharIsWordChar
 #define Tcl_UniCharIsWordChar \
 	(tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */
+#endif
+#ifndef Tcl_UniCharLen
 #define Tcl_UniCharLen \
 	(tclStubsPtr->tcl_UniCharLen) /* 352 */
+#endif
+#ifndef Tcl_UniCharNcmp
 #define Tcl_UniCharNcmp \
 	(tclStubsPtr->tcl_UniCharNcmp) /* 353 */
+#endif
+#ifndef Tcl_UniCharToUtfDString
 #define Tcl_UniCharToUtfDString \
 	(tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */
+#endif
+#ifndef Tcl_UtfToUniCharDString
 #define Tcl_UtfToUniCharDString \
 	(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
+#endif
+#ifndef Tcl_GetRegExpFromObj
 #define Tcl_GetRegExpFromObj \
 	(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
+#endif
+#ifndef Tcl_EvalTokens
 #define Tcl_EvalTokens \
 	(tclStubsPtr->tcl_EvalTokens) /* 357 */
+#endif
+#ifndef Tcl_FreeParse
 #define Tcl_FreeParse \
 	(tclStubsPtr->tcl_FreeParse) /* 358 */
+#endif
+#ifndef Tcl_LogCommandInfo
 #define Tcl_LogCommandInfo \
 	(tclStubsPtr->tcl_LogCommandInfo) /* 359 */
+#endif
+#ifndef Tcl_ParseBraces
 #define Tcl_ParseBraces \
 	(tclStubsPtr->tcl_ParseBraces) /* 360 */
+#endif
+#ifndef Tcl_ParseCommand
 #define Tcl_ParseCommand \
 	(tclStubsPtr->tcl_ParseCommand) /* 361 */
+#endif
+#ifndef Tcl_ParseExpr
 #define Tcl_ParseExpr \
 	(tclStubsPtr->tcl_ParseExpr) /* 362 */
+#endif
+#ifndef Tcl_ParseQuotedString
 #define Tcl_ParseQuotedString \
 	(tclStubsPtr->tcl_ParseQuotedString) /* 363 */
+#endif
+#ifndef Tcl_ParseVarName
 #define Tcl_ParseVarName \
 	(tclStubsPtr->tcl_ParseVarName) /* 364 */
+#endif
+#ifndef Tcl_GetCwd
 #define Tcl_GetCwd \
 	(tclStubsPtr->tcl_GetCwd) /* 365 */
+#endif
+#ifndef Tcl_Chdir
 #define Tcl_Chdir \
 	(tclStubsPtr->tcl_Chdir) /* 366 */
+#endif
+#ifndef Tcl_Access
 #define Tcl_Access \
 	(tclStubsPtr->tcl_Access) /* 367 */
+#endif
+#ifndef Tcl_Stat
 #define Tcl_Stat \
 	(tclStubsPtr->tcl_Stat) /* 368 */
+#endif
+#ifndef Tcl_UtfNcmp
 #define Tcl_UtfNcmp \
 	(tclStubsPtr->tcl_UtfNcmp) /* 369 */
+#endif
+#ifndef Tcl_UtfNcasecmp
 #define Tcl_UtfNcasecmp \
 	(tclStubsPtr->tcl_UtfNcasecmp) /* 370 */
+#endif
+#ifndef Tcl_StringCaseMatch
 #define Tcl_StringCaseMatch \
 	(tclStubsPtr->tcl_StringCaseMatch) /* 371 */
+#endif
+#ifndef Tcl_UniCharIsControl
 #define Tcl_UniCharIsControl \
 	(tclStubsPtr->tcl_UniCharIsControl) /* 372 */
+#endif
+#ifndef Tcl_UniCharIsGraph
 #define Tcl_UniCharIsGraph \
 	(tclStubsPtr->tcl_UniCharIsGraph) /* 373 */
+#endif
+#ifndef Tcl_UniCharIsPrint
 #define Tcl_UniCharIsPrint \
 	(tclStubsPtr->tcl_UniCharIsPrint) /* 374 */
+#endif
+#ifndef Tcl_UniCharIsPunct
 #define Tcl_UniCharIsPunct \
 	(tclStubsPtr->tcl_UniCharIsPunct) /* 375 */
+#endif
+#ifndef Tcl_RegExpExecObj
 #define Tcl_RegExpExecObj \
 	(tclStubsPtr->tcl_RegExpExecObj) /* 376 */
+#endif
+#ifndef Tcl_RegExpGetInfo
 #define Tcl_RegExpGetInfo \
 	(tclStubsPtr->tcl_RegExpGetInfo) /* 377 */
+#endif
+#ifndef Tcl_NewUnicodeObj
 #define Tcl_NewUnicodeObj \
 	(tclStubsPtr->tcl_NewUnicodeObj) /* 378 */
+#endif
+#ifndef Tcl_SetUnicodeObj
 #define Tcl_SetUnicodeObj \
 	(tclStubsPtr->tcl_SetUnicodeObj) /* 379 */
+#endif
+#ifndef Tcl_GetCharLength
 #define Tcl_GetCharLength \
 	(tclStubsPtr->tcl_GetCharLength) /* 380 */
+#endif
+#ifndef Tcl_GetUniChar
 #define Tcl_GetUniChar \
 	(tclStubsPtr->tcl_GetUniChar) /* 381 */
+#endif
+#ifndef Tcl_GetUnicode
 #define Tcl_GetUnicode \
 	(tclStubsPtr->tcl_GetUnicode) /* 382 */
+#endif
+#ifndef Tcl_GetRange
 #define Tcl_GetRange \
 	(tclStubsPtr->tcl_GetRange) /* 383 */
+#endif
+#ifndef Tcl_AppendUnicodeToObj
 #define Tcl_AppendUnicodeToObj \
 	(tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */
+#endif
+#ifndef Tcl_RegExpMatchObj
 #define Tcl_RegExpMatchObj \
 	(tclStubsPtr->tcl_RegExpMatchObj) /* 385 */
+#endif
+#ifndef Tcl_SetNotifier
 #define Tcl_SetNotifier \
 	(tclStubsPtr->tcl_SetNotifier) /* 386 */
+#endif
+#ifndef Tcl_GetAllocMutex
 #define Tcl_GetAllocMutex \
 	(tclStubsPtr->tcl_GetAllocMutex) /* 387 */
+#endif
+#ifndef Tcl_GetChannelNames
 #define Tcl_GetChannelNames \
 	(tclStubsPtr->tcl_GetChannelNames) /* 388 */
+#endif
+#ifndef Tcl_GetChannelNamesEx
 #define Tcl_GetChannelNamesEx \
 	(tclStubsPtr->tcl_GetChannelNamesEx) /* 389 */
+#endif
+#ifndef Tcl_ProcObjCmd
 #define Tcl_ProcObjCmd \
 	(tclStubsPtr->tcl_ProcObjCmd) /* 390 */
+#endif
+#ifndef Tcl_ConditionFinalize
 #define Tcl_ConditionFinalize \
 	(tclStubsPtr->tcl_ConditionFinalize) /* 391 */
+#endif
+#ifndef Tcl_MutexFinalize
 #define Tcl_MutexFinalize \
 	(tclStubsPtr->tcl_MutexFinalize) /* 392 */
+#endif
+#ifndef Tcl_CreateThread
 #define Tcl_CreateThread \
 	(tclStubsPtr->tcl_CreateThread) /* 393 */
+#endif
+#ifndef Tcl_ReadRaw
 #define Tcl_ReadRaw \
 	(tclStubsPtr->tcl_ReadRaw) /* 394 */
+#endif
+#ifndef Tcl_WriteRaw
 #define Tcl_WriteRaw \
 	(tclStubsPtr->tcl_WriteRaw) /* 395 */
+#endif
+#ifndef Tcl_GetTopChannel
 #define Tcl_GetTopChannel \
 	(tclStubsPtr->tcl_GetTopChannel) /* 396 */
+#endif
+#ifndef Tcl_ChannelBuffered
 #define Tcl_ChannelBuffered \
 	(tclStubsPtr->tcl_ChannelBuffered) /* 397 */
+#endif
+#ifndef Tcl_ChannelName
 #define Tcl_ChannelName \
 	(tclStubsPtr->tcl_ChannelName) /* 398 */
+#endif
+#ifndef Tcl_ChannelVersion
 #define Tcl_ChannelVersion \
 	(tclStubsPtr->tcl_ChannelVersion) /* 399 */
+#endif
+#ifndef Tcl_ChannelBlockModeProc
 #define Tcl_ChannelBlockModeProc \
 	(tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */
+#endif
+#ifndef Tcl_ChannelCloseProc
 #define Tcl_ChannelCloseProc \
 	(tclStubsPtr->tcl_ChannelCloseProc) /* 401 */
+#endif
+#ifndef Tcl_ChannelClose2Proc
 #define Tcl_ChannelClose2Proc \
 	(tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
+#endif
+#ifndef Tcl_ChannelInputProc
 #define Tcl_ChannelInputProc \
 	(tclStubsPtr->tcl_ChannelInputProc) /* 403 */
+#endif
+#ifndef Tcl_ChannelOutputProc
 #define Tcl_ChannelOutputProc \
 	(tclStubsPtr->tcl_ChannelOutputProc) /* 404 */
+#endif
+#ifndef Tcl_ChannelSeekProc
 #define Tcl_ChannelSeekProc \
 	(tclStubsPtr->tcl_ChannelSeekProc) /* 405 */
+#endif
+#ifndef Tcl_ChannelSetOptionProc
 #define Tcl_ChannelSetOptionProc \
 	(tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
+#endif
+#ifndef Tcl_ChannelGetOptionProc
 #define Tcl_ChannelGetOptionProc \
 	(tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */
+#endif
+#ifndef Tcl_ChannelWatchProc
 #define Tcl_ChannelWatchProc \
 	(tclStubsPtr->tcl_ChannelWatchProc) /* 408 */
+#endif
+#ifndef Tcl_ChannelGetHandleProc
 #define Tcl_ChannelGetHandleProc \
 	(tclStubsPtr->tcl_ChannelGetHandleProc) /* 409 */
+#endif
+#ifndef Tcl_ChannelFlushProc
 #define Tcl_ChannelFlushProc \
 	(tclStubsPtr->tcl_ChannelFlushProc) /* 410 */
+#endif
+#ifndef Tcl_ChannelHandlerProc
 #define Tcl_ChannelHandlerProc \
 	(tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */
+#endif
+#ifndef Tcl_JoinThread
 #define Tcl_JoinThread \
 	(tclStubsPtr->tcl_JoinThread) /* 412 */
+#endif
+#ifndef Tcl_IsChannelShared
 #define Tcl_IsChannelShared \
 	(tclStubsPtr->tcl_IsChannelShared) /* 413 */
+#endif
+#ifndef Tcl_IsChannelRegistered
 #define Tcl_IsChannelRegistered \
 	(tclStubsPtr->tcl_IsChannelRegistered) /* 414 */
+#endif
+#ifndef Tcl_CutChannel
 #define Tcl_CutChannel \
 	(tclStubsPtr->tcl_CutChannel) /* 415 */
+#endif
+#ifndef Tcl_SpliceChannel
 #define Tcl_SpliceChannel \
 	(tclStubsPtr->tcl_SpliceChannel) /* 416 */
+#endif
+#ifndef Tcl_ClearChannelHandlers
 #define Tcl_ClearChannelHandlers \
 	(tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */
+#endif
+#ifndef Tcl_IsChannelExisting
 #define Tcl_IsChannelExisting \
 	(tclStubsPtr->tcl_IsChannelExisting) /* 418 */
+#endif
+#ifndef Tcl_UniCharNcasecmp
 #define Tcl_UniCharNcasecmp \
 	(tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */
+#endif
+#ifndef Tcl_UniCharCaseMatch
 #define Tcl_UniCharCaseMatch \
 	(tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */
+#endif
+#ifndef Tcl_FindHashEntry
 #define Tcl_FindHashEntry \
 	(tclStubsPtr->tcl_FindHashEntry) /* 421 */
+#endif
+#ifndef Tcl_CreateHashEntry
 #define Tcl_CreateHashEntry \
 	(tclStubsPtr->tcl_CreateHashEntry) /* 422 */
+#endif
+#ifndef Tcl_InitCustomHashTable
 #define Tcl_InitCustomHashTable \
 	(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
+#endif
+#ifndef Tcl_InitObjHashTable
 #define Tcl_InitObjHashTable \
 	(tclStubsPtr->tcl_InitObjHashTable) /* 424 */
+#endif
+#ifndef Tcl_CommandTraceInfo
 #define Tcl_CommandTraceInfo \
 	(tclStubsPtr->tcl_CommandTraceInfo) /* 425 */
+#endif
+#ifndef Tcl_TraceCommand
 #define Tcl_TraceCommand \
 	(tclStubsPtr->tcl_TraceCommand) /* 426 */
+#endif
+#ifndef Tcl_UntraceCommand
 #define Tcl_UntraceCommand \
 	(tclStubsPtr->tcl_UntraceCommand) /* 427 */
+#endif
+#ifndef Tcl_AttemptAlloc
 #define Tcl_AttemptAlloc \
 	(tclStubsPtr->tcl_AttemptAlloc) /* 428 */
+#endif
+#ifndef Tcl_AttemptDbCkalloc
 #define Tcl_AttemptDbCkalloc \
 	(tclStubsPtr->tcl_AttemptDbCkalloc) /* 429 */
+#endif
+#ifndef Tcl_AttemptRealloc
 #define Tcl_AttemptRealloc \
 	(tclStubsPtr->tcl_AttemptRealloc) /* 430 */
+#endif
+#ifndef Tcl_AttemptDbCkrealloc
 #define Tcl_AttemptDbCkrealloc \
 	(tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */
+#endif
+#ifndef Tcl_AttemptSetObjLength
 #define Tcl_AttemptSetObjLength \
 	(tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */
+#endif
+#ifndef Tcl_GetChannelThread
 #define Tcl_GetChannelThread \
 	(tclStubsPtr->tcl_GetChannelThread) /* 433 */
+#endif
+#ifndef Tcl_GetUnicodeFromObj
 #define Tcl_GetUnicodeFromObj \
 	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
+#endif
+#ifndef Tcl_GetMathFuncInfo
 #define Tcl_GetMathFuncInfo \
 	(tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
+#endif
+#ifndef Tcl_ListMathFuncs
 #define Tcl_ListMathFuncs \
 	(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
+#endif
+#ifndef Tcl_SubstObj
 #define Tcl_SubstObj \
 	(tclStubsPtr->tcl_SubstObj) /* 437 */
+#endif
+#ifndef Tcl_DetachChannel
 #define Tcl_DetachChannel \
 	(tclStubsPtr->tcl_DetachChannel) /* 438 */
+#endif
+#ifndef Tcl_IsStandardChannel
 #define Tcl_IsStandardChannel \
 	(tclStubsPtr->tcl_IsStandardChannel) /* 439 */
+#endif
+#ifndef Tcl_FSCopyFile
 #define Tcl_FSCopyFile \
 	(tclStubsPtr->tcl_FSCopyFile) /* 440 */
+#endif
+#ifndef Tcl_FSCopyDirectory
 #define Tcl_FSCopyDirectory \
 	(tclStubsPtr->tcl_FSCopyDirectory) /* 441 */
+#endif
+#ifndef Tcl_FSCreateDirectory
 #define Tcl_FSCreateDirectory \
 	(tclStubsPtr->tcl_FSCreateDirectory) /* 442 */
+#endif
+#ifndef Tcl_FSDeleteFile
 #define Tcl_FSDeleteFile \
 	(tclStubsPtr->tcl_FSDeleteFile) /* 443 */
+#endif
+#ifndef Tcl_FSLoadFile
 #define Tcl_FSLoadFile \
 	(tclStubsPtr->tcl_FSLoadFile) /* 444 */
+#endif
+#ifndef Tcl_FSMatchInDirectory
 #define Tcl_FSMatchInDirectory \
 	(tclStubsPtr->tcl_FSMatchInDirectory) /* 445 */
+#endif
+#ifndef Tcl_FSLink
 #define Tcl_FSLink \
 	(tclStubsPtr->tcl_FSLink) /* 446 */
+#endif
+#ifndef Tcl_FSRemoveDirectory
 #define Tcl_FSRemoveDirectory \
 	(tclStubsPtr->tcl_FSRemoveDirectory) /* 447 */
+#endif
+#ifndef Tcl_FSRenameFile
 #define Tcl_FSRenameFile \
 	(tclStubsPtr->tcl_FSRenameFile) /* 448 */
+#endif
+#ifndef Tcl_FSLstat
 #define Tcl_FSLstat \
 	(tclStubsPtr->tcl_FSLstat) /* 449 */
+#endif
+#ifndef Tcl_FSUtime
 #define Tcl_FSUtime \
 	(tclStubsPtr->tcl_FSUtime) /* 450 */
+#endif
+#ifndef Tcl_FSFileAttrsGet
 #define Tcl_FSFileAttrsGet \
 	(tclStubsPtr->tcl_FSFileAttrsGet) /* 451 */
+#endif
+#ifndef Tcl_FSFileAttrsSet
 #define Tcl_FSFileAttrsSet \
 	(tclStubsPtr->tcl_FSFileAttrsSet) /* 452 */
+#endif
+#ifndef Tcl_FSFileAttrStrings
 #define Tcl_FSFileAttrStrings \
 	(tclStubsPtr->tcl_FSFileAttrStrings) /* 453 */
+#endif
+#ifndef Tcl_FSStat
 #define Tcl_FSStat \
 	(tclStubsPtr->tcl_FSStat) /* 454 */
+#endif
+#ifndef Tcl_FSAccess
 #define Tcl_FSAccess \
 	(tclStubsPtr->tcl_FSAccess) /* 455 */
+#endif
+#ifndef Tcl_FSOpenFileChannel
 #define Tcl_FSOpenFileChannel \
 	(tclStubsPtr->tcl_FSOpenFileChannel) /* 456 */
+#endif
+#ifndef Tcl_FSGetCwd
 #define Tcl_FSGetCwd \
 	(tclStubsPtr->tcl_FSGetCwd) /* 457 */
+#endif
+#ifndef Tcl_FSChdir
 #define Tcl_FSChdir \
 	(tclStubsPtr->tcl_FSChdir) /* 458 */
+#endif
+#ifndef Tcl_FSConvertToPathType
 #define Tcl_FSConvertToPathType \
 	(tclStubsPtr->tcl_FSConvertToPathType) /* 459 */
+#endif
+#ifndef Tcl_FSJoinPath
 #define Tcl_FSJoinPath \
 	(tclStubsPtr->tcl_FSJoinPath) /* 460 */
+#endif
+#ifndef Tcl_FSSplitPath
 #define Tcl_FSSplitPath \
 	(tclStubsPtr->tcl_FSSplitPath) /* 461 */
+#endif
+#ifndef Tcl_FSEqualPaths
 #define Tcl_FSEqualPaths \
 	(tclStubsPtr->tcl_FSEqualPaths) /* 462 */
+#endif
+#ifndef Tcl_FSGetNormalizedPath
 #define Tcl_FSGetNormalizedPath \
 	(tclStubsPtr->tcl_FSGetNormalizedPath) /* 463 */
+#endif
+#ifndef Tcl_FSJoinToPath
 #define Tcl_FSJoinToPath \
 	(tclStubsPtr->tcl_FSJoinToPath) /* 464 */
+#endif
+#ifndef Tcl_FSGetInternalRep
 #define Tcl_FSGetInternalRep \
 	(tclStubsPtr->tcl_FSGetInternalRep) /* 465 */
+#endif
+#ifndef Tcl_FSGetTranslatedPath
 #define Tcl_FSGetTranslatedPath \
 	(tclStubsPtr->tcl_FSGetTranslatedPath) /* 466 */
+#endif
+#ifndef Tcl_FSEvalFile
 #define Tcl_FSEvalFile \
 	(tclStubsPtr->tcl_FSEvalFile) /* 467 */
+#endif
+#ifndef Tcl_FSNewNativePath
 #define Tcl_FSNewNativePath \
 	(tclStubsPtr->tcl_FSNewNativePath) /* 468 */
+#endif
+#ifndef Tcl_FSGetNativePath
 #define Tcl_FSGetNativePath \
 	(tclStubsPtr->tcl_FSGetNativePath) /* 469 */
+#endif
+#ifndef Tcl_FSFileSystemInfo
 #define Tcl_FSFileSystemInfo \
 	(tclStubsPtr->tcl_FSFileSystemInfo) /* 470 */
+#endif
+#ifndef Tcl_FSPathSeparator
 #define Tcl_FSPathSeparator \
 	(tclStubsPtr->tcl_FSPathSeparator) /* 471 */
+#endif
+#ifndef Tcl_FSListVolumes
 #define Tcl_FSListVolumes \
 	(tclStubsPtr->tcl_FSListVolumes) /* 472 */
+#endif
+#ifndef Tcl_FSRegister
 #define Tcl_FSRegister \
 	(tclStubsPtr->tcl_FSRegister) /* 473 */
+#endif
+#ifndef Tcl_FSUnregister
 #define Tcl_FSUnregister \
 	(tclStubsPtr->tcl_FSUnregister) /* 474 */
+#endif
+#ifndef Tcl_FSData
 #define Tcl_FSData \
 	(tclStubsPtr->tcl_FSData) /* 475 */
+#endif
+#ifndef Tcl_FSGetTranslatedStringPath
 #define Tcl_FSGetTranslatedStringPath \
 	(tclStubsPtr->tcl_FSGetTranslatedStringPath) /* 476 */
+#endif
+#ifndef Tcl_FSGetFileSystemForPath
 #define Tcl_FSGetFileSystemForPath \
 	(tclStubsPtr->tcl_FSGetFileSystemForPath) /* 477 */
+#endif
+#ifndef Tcl_FSGetPathType
 #define Tcl_FSGetPathType \
 	(tclStubsPtr->tcl_FSGetPathType) /* 478 */
+#endif
+#ifndef Tcl_OutputBuffered
 #define Tcl_OutputBuffered \
 	(tclStubsPtr->tcl_OutputBuffered) /* 479 */
+#endif
+#ifndef Tcl_FSMountsChanged
 #define Tcl_FSMountsChanged \
 	(tclStubsPtr->tcl_FSMountsChanged) /* 480 */
+#endif
+#ifndef Tcl_EvalTokensStandard
 #define Tcl_EvalTokensStandard \
 	(tclStubsPtr->tcl_EvalTokensStandard) /* 481 */
+#endif
+#ifndef Tcl_GetTime
 #define Tcl_GetTime \
 	(tclStubsPtr->tcl_GetTime) /* 482 */
+#endif
+#ifndef Tcl_CreateObjTrace
 #define Tcl_CreateObjTrace \
 	(tclStubsPtr->tcl_CreateObjTrace) /* 483 */
+#endif
+#ifndef Tcl_GetCommandInfoFromToken
 #define Tcl_GetCommandInfoFromToken \
 	(tclStubsPtr->tcl_GetCommandInfoFromToken) /* 484 */
+#endif
+#ifndef Tcl_SetCommandInfoFromToken
 #define Tcl_SetCommandInfoFromToken \
 	(tclStubsPtr->tcl_SetCommandInfoFromToken) /* 485 */
+#endif
+#ifndef Tcl_DbNewWideIntObj
 #define Tcl_DbNewWideIntObj \
 	(tclStubsPtr->tcl_DbNewWideIntObj) /* 486 */
+#endif
+#ifndef Tcl_GetWideIntFromObj
 #define Tcl_GetWideIntFromObj \
 	(tclStubsPtr->tcl_GetWideIntFromObj) /* 487 */
+#endif
+#ifndef Tcl_NewWideIntObj
 #define Tcl_NewWideIntObj \
 	(tclStubsPtr->tcl_NewWideIntObj) /* 488 */
+#endif
+#ifndef Tcl_SetWideIntObj
 #define Tcl_SetWideIntObj \
 	(tclStubsPtr->tcl_SetWideIntObj) /* 489 */
+#endif
+#ifndef Tcl_AllocStatBuf
 #define Tcl_AllocStatBuf \
 	(tclStubsPtr->tcl_AllocStatBuf) /* 490 */
+#endif
+#ifndef Tcl_Seek
 #define Tcl_Seek \
 	(tclStubsPtr->tcl_Seek) /* 491 */
+#endif
+#ifndef Tcl_Tell
 #define Tcl_Tell \
 	(tclStubsPtr->tcl_Tell) /* 492 */
+#endif
+#ifndef Tcl_ChannelWideSeekProc
 #define Tcl_ChannelWideSeekProc \
 	(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
-#define Tcl_DictObjPut \
-	(tclStubsPtr->tcl_DictObjPut) /* 494 */
-#define Tcl_DictObjGet \
-	(tclStubsPtr->tcl_DictObjGet) /* 495 */
-#define Tcl_DictObjRemove \
-	(tclStubsPtr->tcl_DictObjRemove) /* 496 */
-#define Tcl_DictObjSize \
-	(tclStubsPtr->tcl_DictObjSize) /* 497 */
-#define Tcl_DictObjFirst \
-	(tclStubsPtr->tcl_DictObjFirst) /* 498 */
-#define Tcl_DictObjNext \
-	(tclStubsPtr->tcl_DictObjNext) /* 499 */
-#define Tcl_DictObjDone \
-	(tclStubsPtr->tcl_DictObjDone) /* 500 */
-#define Tcl_DictObjPutKeyList \
-	(tclStubsPtr->tcl_DictObjPutKeyList) /* 501 */
-#define Tcl_DictObjRemoveKeyList \
-	(tclStubsPtr->tcl_DictObjRemoveKeyList) /* 502 */
-#define Tcl_NewDictObj \
-	(tclStubsPtr->tcl_NewDictObj) /* 503 */
-#define Tcl_DbNewDictObj \
-	(tclStubsPtr->tcl_DbNewDictObj) /* 504 */
-#define Tcl_RegisterConfig \
-	(tclStubsPtr->tcl_RegisterConfig) /* 505 */
-#define Tcl_CreateNamespace \
-	(tclStubsPtr->tcl_CreateNamespace) /* 506 */
-#define Tcl_DeleteNamespace \
-	(tclStubsPtr->tcl_DeleteNamespace) /* 507 */
-#define Tcl_AppendExportList \
-	(tclStubsPtr->tcl_AppendExportList) /* 508 */
-#define Tcl_Export \
-	(tclStubsPtr->tcl_Export) /* 509 */
-#define Tcl_Import \
-	(tclStubsPtr->tcl_Import) /* 510 */
-#define Tcl_ForgetImport \
-	(tclStubsPtr->tcl_ForgetImport) /* 511 */
-#define Tcl_GetCurrentNamespace \
-	(tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
-#define Tcl_GetGlobalNamespace \
-	(tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
-#define Tcl_FindNamespace \
-	(tclStubsPtr->tcl_FindNamespace) /* 514 */
-#define Tcl_FindCommand \
-	(tclStubsPtr->tcl_FindCommand) /* 515 */
-#define Tcl_GetCommandFromObj \
-	(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
-#define Tcl_GetCommandFullName \
-	(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
-#define Tcl_FSEvalFileEx \
-	(tclStubsPtr->tcl_FSEvalFileEx) /* 518 */
-#define Tcl_SetExitProc \
-	(tclStubsPtr->tcl_SetExitProc) /* 519 */
-#define Tcl_LimitAddHandler \
-	(tclStubsPtr->tcl_LimitAddHandler) /* 520 */
-#define Tcl_LimitRemoveHandler \
-	(tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */
-#define Tcl_LimitReady \
-	(tclStubsPtr->tcl_LimitReady) /* 522 */
-#define Tcl_LimitCheck \
-	(tclStubsPtr->tcl_LimitCheck) /* 523 */
-#define Tcl_LimitExceeded \
-	(tclStubsPtr->tcl_LimitExceeded) /* 524 */
-#define Tcl_LimitSetCommands \
-	(tclStubsPtr->tcl_LimitSetCommands) /* 525 */
-#define Tcl_LimitSetTime \
-	(tclStubsPtr->tcl_LimitSetTime) /* 526 */
-#define Tcl_LimitSetGranularity \
-	(tclStubsPtr->tcl_LimitSetGranularity) /* 527 */
-#define Tcl_LimitTypeEnabled \
-	(tclStubsPtr->tcl_LimitTypeEnabled) /* 528 */
-#define Tcl_LimitTypeExceeded \
-	(tclStubsPtr->tcl_LimitTypeExceeded) /* 529 */
-#define Tcl_LimitTypeSet \
-	(tclStubsPtr->tcl_LimitTypeSet) /* 530 */
-#define Tcl_LimitTypeReset \
-	(tclStubsPtr->tcl_LimitTypeReset) /* 531 */
-#define Tcl_LimitGetCommands \
-	(tclStubsPtr->tcl_LimitGetCommands) /* 532 */
-#define Tcl_LimitGetTime \
-	(tclStubsPtr->tcl_LimitGetTime) /* 533 */
-#define Tcl_LimitGetGranularity \
-	(tclStubsPtr->tcl_LimitGetGranularity) /* 534 */
-#define Tcl_SaveInterpState \
-	(tclStubsPtr->tcl_SaveInterpState) /* 535 */
-#define Tcl_RestoreInterpState \
-	(tclStubsPtr->tcl_RestoreInterpState) /* 536 */
-#define Tcl_DiscardInterpState \
-	(tclStubsPtr->tcl_DiscardInterpState) /* 537 */
-#define Tcl_SetReturnOptions \
-	(tclStubsPtr->tcl_SetReturnOptions) /* 538 */
-#define Tcl_GetReturnOptions \
-	(tclStubsPtr->tcl_GetReturnOptions) /* 539 */
-#define Tcl_IsEnsemble \
-	(tclStubsPtr->tcl_IsEnsemble) /* 540 */
-#define Tcl_CreateEnsemble \
-	(tclStubsPtr->tcl_CreateEnsemble) /* 541 */
-#define Tcl_FindEnsemble \
-	(tclStubsPtr->tcl_FindEnsemble) /* 542 */
-#define Tcl_SetEnsembleSubcommandList \
-	(tclStubsPtr->tcl_SetEnsembleSubcommandList) /* 543 */
-#define Tcl_SetEnsembleMappingDict \
-	(tclStubsPtr->tcl_SetEnsembleMappingDict) /* 544 */
-#define Tcl_SetEnsembleUnknownHandler \
-	(tclStubsPtr->tcl_SetEnsembleUnknownHandler) /* 545 */
-#define Tcl_SetEnsembleFlags \
-	(tclStubsPtr->tcl_SetEnsembleFlags) /* 546 */
-#define Tcl_GetEnsembleSubcommandList \
-	(tclStubsPtr->tcl_GetEnsembleSubcommandList) /* 547 */
-#define Tcl_GetEnsembleMappingDict \
-	(tclStubsPtr->tcl_GetEnsembleMappingDict) /* 548 */
-#define Tcl_GetEnsembleUnknownHandler \
-	(tclStubsPtr->tcl_GetEnsembleUnknownHandler) /* 549 */
-#define Tcl_GetEnsembleFlags \
-	(tclStubsPtr->tcl_GetEnsembleFlags) /* 550 */
-#define Tcl_GetEnsembleNamespace \
-	(tclStubsPtr->tcl_GetEnsembleNamespace) /* 551 */
-#define Tcl_SetTimeProc \
-	(tclStubsPtr->tcl_SetTimeProc) /* 552 */
-#define Tcl_QueryTimeProc \
-	(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
+#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_ChannelThreadActionProc
 #define Tcl_ChannelThreadActionProc \
 	(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
-#define Tcl_NewBignumObj \
-	(tclStubsPtr->tcl_NewBignumObj) /* 555 */
-#define Tcl_DbNewBignumObj \
-	(tclStubsPtr->tcl_DbNewBignumObj) /* 556 */
-#define Tcl_SetBignumObj \
-	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
-#define Tcl_GetBignumFromObj \
-	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
-#define Tcl_TakeBignumFromObj \
-	(tclStubsPtr->tcl_TakeBignumFromObj) /* 559 */
-#define Tcl_TruncateChannel \
-	(tclStubsPtr->tcl_TruncateChannel) /* 560 */
-#define Tcl_ChannelTruncateProc \
-	(tclStubsPtr->tcl_ChannelTruncateProc) /* 561 */
-#define Tcl_SetChannelErrorInterp \
-	(tclStubsPtr->tcl_SetChannelErrorInterp) /* 562 */
-#define Tcl_GetChannelErrorInterp \
-	(tclStubsPtr->tcl_GetChannelErrorInterp) /* 563 */
-#define Tcl_SetChannelError \
-	(tclStubsPtr->tcl_SetChannelError) /* 564 */
-#define Tcl_GetChannelError \
-	(tclStubsPtr->tcl_GetChannelError) /* 565 */
-#define Tcl_InitBignumFromDouble \
-	(tclStubsPtr->tcl_InitBignumFromDouble) /* 566 */
-#define Tcl_GetNamespaceUnknownHandler \
-	(tclStubsPtr->tcl_GetNamespaceUnknownHandler) /* 567 */
-#define Tcl_SetNamespaceUnknownHandler \
-	(tclStubsPtr->tcl_SetNamespaceUnknownHandler) /* 568 */
-#define Tcl_GetEncodingFromObj \
-	(tclStubsPtr->tcl_GetEncodingFromObj) /* 569 */
-#define Tcl_GetEncodingSearchPath \
-	(tclStubsPtr->tcl_GetEncodingSearchPath) /* 570 */
-#define Tcl_SetEncodingSearchPath \
-	(tclStubsPtr->tcl_SetEncodingSearchPath) /* 571 */
-#define Tcl_GetEncodingNameFromEnvironment \
-	(tclStubsPtr->tcl_GetEncodingNameFromEnvironment) /* 572 */
+#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_PkgRequireProc
 #define Tcl_PkgRequireProc \
 	(tclStubsPtr->tcl_PkgRequireProc) /* 573 */
-#define Tcl_AppendObjToErrorInfo \
-	(tclStubsPtr->tcl_AppendObjToErrorInfo) /* 574 */
-#define Tcl_AppendLimitedToObj \
-	(tclStubsPtr->tcl_AppendLimitedToObj) /* 575 */
-#define Tcl_Format \
-	(tclStubsPtr->tcl_Format) /* 576 */
-#define Tcl_AppendFormatToObj \
-	(tclStubsPtr->tcl_AppendFormatToObj) /* 577 */
-#define Tcl_ObjPrintf \
-	(tclStubsPtr->tcl_ObjPrintf) /* 578 */
-#define Tcl_AppendPrintfToObj \
-	(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
-#define Tcl_CancelEval \
-	(tclStubsPtr->tcl_CancelEval) /* 580 */
-#define Tcl_Canceled \
-	(tclStubsPtr->tcl_Canceled) /* 581 */
-#define Tcl_CreatePipe \
-	(tclStubsPtr->tcl_CreatePipe) /* 582 */
-#define Tcl_NRCreateCommand \
-	(tclStubsPtr->tcl_NRCreateCommand) /* 583 */
-#define Tcl_NREvalObj \
-	(tclStubsPtr->tcl_NREvalObj) /* 584 */
-#define Tcl_NREvalObjv \
-	(tclStubsPtr->tcl_NREvalObjv) /* 585 */
-#define Tcl_NRCmdSwap \
-	(tclStubsPtr->tcl_NRCmdSwap) /* 586 */
-#define Tcl_NRAddCallback \
-	(tclStubsPtr->tcl_NRAddCallback) /* 587 */
-#define Tcl_NRCallObjProc \
-	(tclStubsPtr->tcl_NRCallObjProc) /* 588 */
-#define Tcl_GetFSDeviceFromStat \
-	(tclStubsPtr->tcl_GetFSDeviceFromStat) /* 589 */
-#define Tcl_GetFSInodeFromStat \
-	(tclStubsPtr->tcl_GetFSInodeFromStat) /* 590 */
-#define Tcl_GetModeFromStat \
-	(tclStubsPtr->tcl_GetModeFromStat) /* 591 */
-#define Tcl_GetLinkCountFromStat \
-	(tclStubsPtr->tcl_GetLinkCountFromStat) /* 592 */
-#define Tcl_GetUserIdFromStat \
-	(tclStubsPtr->tcl_GetUserIdFromStat) /* 593 */
-#define Tcl_GetGroupIdFromStat \
-	(tclStubsPtr->tcl_GetGroupIdFromStat) /* 594 */
-#define Tcl_GetDeviceTypeFromStat \
-	(tclStubsPtr->tcl_GetDeviceTypeFromStat) /* 595 */
-#define Tcl_GetAccessTimeFromStat \
-	(tclStubsPtr->tcl_GetAccessTimeFromStat) /* 596 */
-#define Tcl_GetModificationTimeFromStat \
-	(tclStubsPtr->tcl_GetModificationTimeFromStat) /* 597 */
-#define Tcl_GetChangeTimeFromStat \
-	(tclStubsPtr->tcl_GetChangeTimeFromStat) /* 598 */
-#define Tcl_GetSizeFromStat \
-	(tclStubsPtr->tcl_GetSizeFromStat) /* 599 */
-#define Tcl_GetBlocksFromStat \
-	(tclStubsPtr->tcl_GetBlocksFromStat) /* 600 */
-#define Tcl_GetBlockSizeFromStat \
-	(tclStubsPtr->tcl_GetBlockSizeFromStat) /* 601 */
-#define Tcl_SetEnsembleParameterList \
-	(tclStubsPtr->tcl_SetEnsembleParameterList) /* 602 */
-#define Tcl_GetEnsembleParameterList \
-	(tclStubsPtr->tcl_GetEnsembleParameterList) /* 603 */
-#define Tcl_ParseArgsObjv \
-	(tclStubsPtr->tcl_ParseArgsObjv) /* 604 */
-#define Tcl_GetErrorLine \
-	(tclStubsPtr->tcl_GetErrorLine) /* 605 */
-#define Tcl_SetErrorLine \
-	(tclStubsPtr->tcl_SetErrorLine) /* 606 */
-#define Tcl_TransferResult \
-	(tclStubsPtr->tcl_TransferResult) /* 607 */
-#define Tcl_InterpActive \
-	(tclStubsPtr->tcl_InterpActive) /* 608 */
-#define Tcl_BackgroundException \
-	(tclStubsPtr->tcl_BackgroundException) /* 609 */
-#define Tcl_ZlibDeflate \
-	(tclStubsPtr->tcl_ZlibDeflate) /* 610 */
-#define Tcl_ZlibInflate \
-	(tclStubsPtr->tcl_ZlibInflate) /* 611 */
-#define Tcl_ZlibCRC32 \
-	(tclStubsPtr->tcl_ZlibCRC32) /* 612 */
-#define Tcl_ZlibAdler32 \
-	(tclStubsPtr->tcl_ZlibAdler32) /* 613 */
-#define Tcl_ZlibStreamInit \
-	(tclStubsPtr->tcl_ZlibStreamInit) /* 614 */
-#define Tcl_ZlibStreamGetCommandName \
-	(tclStubsPtr->tcl_ZlibStreamGetCommandName) /* 615 */
-#define Tcl_ZlibStreamEof \
-	(tclStubsPtr->tcl_ZlibStreamEof) /* 616 */
-#define Tcl_ZlibStreamChecksum \
-	(tclStubsPtr->tcl_ZlibStreamChecksum) /* 617 */
-#define Tcl_ZlibStreamPut \
-	(tclStubsPtr->tcl_ZlibStreamPut) /* 618 */
-#define Tcl_ZlibStreamGet \
-	(tclStubsPtr->tcl_ZlibStreamGet) /* 619 */
-#define Tcl_ZlibStreamClose \
-	(tclStubsPtr->tcl_ZlibStreamClose) /* 620 */
-#define Tcl_ZlibStreamReset \
-	(tclStubsPtr->tcl_ZlibStreamReset) /* 621 */
-#define Tcl_SetStartupScript \
-	(tclStubsPtr->tcl_SetStartupScript) /* 622 */
-#define Tcl_GetStartupScript \
-	(tclStubsPtr->tcl_GetStartupScript) /* 623 */
-#define Tcl_CloseEx \
-	(tclStubsPtr->tcl_CloseEx) /* 624 */
-#define Tcl_NRExprObj \
-	(tclStubsPtr->tcl_NRExprObj) /* 625 */
-#define Tcl_NRSubstObj \
-	(tclStubsPtr->tcl_NRSubstObj) /* 626 */
-#define Tcl_LoadFile \
-	(tclStubsPtr->tcl_LoadFile) /* 627 */
-#define Tcl_FindSymbol \
-	(tclStubsPtr->tcl_FindSymbol) /* 628 */
-#define Tcl_FSUnloadFile \
-	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
-
-#endif /* defined(USE_TCL_STUBS) */
-
-/* !END!: Do not edit above this line. */
-
-#if defined(USE_TCL_STUBS)
-#   undef Tcl_CreateInterp
-#   undef Tcl_FindExecutable
-#   undef Tcl_GetStringResult
-#   undef Tcl_Init
-#   undef Tcl_SetPanicProc
-#   undef Tcl_SetVar
-#   undef Tcl_StaticPackage
-#   undef TclFSGetNativePath
-#   define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
-#   define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
-#   define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
-#   define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
-#   define Tcl_SetVar(interp, varName, newValue, flags) \
-	    (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
 #endif
 
-#if defined(_WIN32) && defined(UNICODE)
-#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
-#   define Tcl_MainEx Tcl_MainExW
-    EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
-	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
-#endif
+#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
+/* !END!: Do not edit above this line. */
 
 #endif /* _TCLDECLS */
+
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
deleted file mode 100644
index ac2cb62..0000000
--- a/generic/tclDictObj.c
+++ /dev/null
@@ -1,3448 +0,0 @@
-/*
- * tclDictObj.c --
- *
- *	This file contains functions that implement the Tcl dict object type
- *	and its accessor command.
- *
- * Copyright (c) 2002-2010 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		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);
-static int		FinalizeDictUpdate(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		FinalizeDictWith(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const *objv);
-static int		DictForLoopCallback(ClientData data[],
-			    Tcl_Interp *interp, int result);
-
-
-/*
- * Table of dict subcommand names and implementations.
- */
-
-static const EnsembleImplMap implementationMap[] = {
-    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
-    {"create",	DictCreateCmd, NULL, NULL, NULL, 0 },
-    {"exists",	DictExistsCmd, NULL, NULL, NULL, 0 },
-    {"filter",	DictFilterCmd, NULL, NULL, NULL, 0 },
-    {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
-    {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },
-    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd, NULL, NULL, 0 },
-    {"info",	DictInfoCmd, NULL, NULL, NULL, 0 },
-    {"keys",	DictKeysCmd, NULL, NULL, NULL, 0 },
-    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd, NULL, NULL, 0 },
-    {"merge",	DictMergeCmd, NULL, NULL, NULL, 0 },
-    {"remove",	DictRemoveCmd, NULL, NULL, NULL, 0 },
-    {"replace",	DictReplaceCmd, NULL, NULL, NULL, 0 },
-    {"set",	DictSetCmd,	TclCompileDictSetCmd, NULL, NULL, 0 },
-    {"size",	DictSizeCmd, NULL, NULL, NULL, 0 },
-    {"unset",	DictUnsetCmd, NULL, NULL, NULL, 0 },
-    {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd, NULL, NULL, 0 },
-    {"values",	DictValuesCmd, NULL, NULL, NULL, 0 },
-    {"with",	DictWithCmd,	TclCompileDictWithCmd, NULL, NULL, 0 },
-    {NULL, NULL, NULL, NULL, NULL, 0}
-};
-
-/*
- * 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.
- */
-
-const 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 const 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 = ckalloc(sizeof(ChainEntry));
-    cPtr->entry.key.objPtr = 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, 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, 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.otherValuePtr;
-    Dict *newDict = ckalloc(sizeof(Dict));
-    ChainEntry *cPtr;
-
-    /*
-     * Copy values across from the old hash table.
-     */
-
-    InitChainTable(newDict);
-    for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
-	Tcl_Obj *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, valuePtr);
-	Tcl_IncrRefCount(valuePtr);
-    }
-
-    /*
-     * Initialise other fields.
-     */
-
-    newDict->epoch = 0;
-    newDict->chain = NULL;
-    newDict->refcount = 1;
-
-    /*
-     * Store in the object.
-     */
-
-    copyPtr->internalRep.otherValuePtr = 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.otherValuePtr;
-
-    dict->refcount--;
-    if (dict->refcount <= 0) {
-	DeleteDict(dict);
-    }
-
-    dictPtr->internalRep.otherValuePtr = NULL;	/* Belt and braces! */
-    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(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.otherValuePtr;
-    ChainEntry *cPtr;
-    Tcl_Obj *keyPtr, *valuePtr;
-    int i, length, bytesNeeded = 0;
-    const char *elem;
-    char *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 = ckalloc(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_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(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_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(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 = 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.otherValuePtr = dict;
-    objPtr->typePtr = &tclDictType;
-    return TCL_OK;
-
-  missingValue:
-    if (interp != NULL) {
-	Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
-    }
-    result = TCL_ERROR;
-
-  errorExit:
-    if (interp != NULL) {
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
-    }
-    DeleteChainTable(dict);
-    ckfree(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.otherValuePtr;
-    if (flags & DICT_PATH_UPDATE) {
-	dict->chain = NULL;
-    }
-
-    for (i=0 ; i<keyc ; i++) {
-	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, 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.otherValuePtr;
-	if (flags & DICT_PATH_UPDATE) {
-	    if (Tcl_IsShared(tmpObj)) {
-		TclDecrRefCount(tmpObj);
-		tmpObj = Tcl_DuplicateObj(tmpObj);
-		Tcl_IncrRefCount(tmpObj);
-		Tcl_SetHashValue(hPtr, tmpObj);
-		dict->epoch++;
-		newDict = tmpObj->internalRep.otherValuePtr;
-	    }
-
-	    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.otherValuePtr;
-
-    do {
-	Tcl_InvalidateStringRep(dictObj);
-	dict->epoch++;
-	dictObj = dict->chain;
-	if (dictObj == NULL) {
-	    break;
-	}
-	dict->chain = NULL;
-	dict = dictObj->internalRep.otherValuePtr;
-    } 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) {
-	Tcl_InvalidateStringRep(dictPtr);
-    }
-    dict = dictPtr->internalRep.otherValuePtr;
-    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) {
-	    return result;
-	}
-    }
-
-    dict = dictPtr->internalRep.otherValuePtr;
-    hPtr = Tcl_FindHashEntry(&dict->table, 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) {
-	Tcl_InvalidateStringRep(dictPtr);
-    }
-    dict = dictPtr->internalRep.otherValuePtr;
-    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.otherValuePtr;
-    *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.otherValuePtr;
-    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_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_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.otherValuePtr;
-    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.otherValuePtr;
-    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);
-    Tcl_InvalidateStringRep(dictPtr);
-    dict = ckalloc(sizeof(Dict));
-    InitChainTable(dict);
-    dict->epoch = 0;
-    dict->chain = NULL;
-    dict->refcount = 1;
-    dictPtr->internalRep.otherValuePtr = 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);
-    Tcl_InvalidateStringRep(dictPtr);
-    dict = ckalloc(sizeof(Dict));
-    InitChainTable(dict);
-    dict->epoch = 0;
-    dict->chain = NULL;
-    dict->refcount = 1;
-    dictPtr->internalRep.otherValuePtr = 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 ...?");
-	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 = NULL, *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);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
-		TclGetString(objv[objc-1]), 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 = NULL, *valueObj = NULL;
-    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;
-    const 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 = NULL;
-	int done = 0;
-
-	/*
-	 * 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 = NULL, *listPtr;
-    Tcl_DictSearch search;
-    int done;
-    const 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.otherValuePtr;
-
-    Tcl_SetResult(interp, 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) {
-	Tcl_InvalidateStringRep(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) {
-	Tcl_InvalidateStringRep(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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DictForNRCmd --
- *
- *	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
-DictForNRCmd(
-    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 *searchPtr;
-    int varc, done;
-
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"{keyVar valueVar} dictionary script");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Parse arguments.
-     */
-
-    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;
-    }
-    searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
-    if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
-	    &done) != TCL_OK) {
-	TclStackFree(interp, searchPtr);
-	return TCL_ERROR;
-    }
-    if (done) {
-	TclStackFree(interp, searchPtr);
-	return TCL_OK;
-    }
-    TclListObjGetElements(NULL, objv[1], &varc, &varv);
-    keyVarObj = varv[0];
-    valueVarObj = varv[1];
-    scriptObj = objv[3];
-
-    /*
-     * 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);
-
-    /*
-     * 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, TCL_LEAVE_ERR_MSG) == NULL) {
-	TclDecrRefCount(valueObj);
-	goto error;
-    }
-    TclDecrRefCount(valueObj);
-    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
-	goto error;
-    }
-
-    /*
-     * Run the script.
-     */
-
-    TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
-	    valueVarObj, scriptObj);
-    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
-
-    /*
-     * For unwinding everything on error.
-     */
-
-  error:
-    TclDecrRefCount(keyVarObj);
-    TclDecrRefCount(valueVarObj);
-    TclDecrRefCount(scriptObj);
-    Tcl_DictObjDone(searchPtr);
-    TclStackFree(interp, searchPtr);
-    return TCL_ERROR;
-}
-
-static int
-DictForLoopCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_DictSearch *searchPtr = data[0];
-    Tcl_Obj *keyVarObj = data[1];
-    Tcl_Obj *valueVarObj = data[2];
-    Tcl_Obj *scriptObj = data[3];
-    Tcl_Obj *keyObj, *valueObj;
-    int done;
-
-    /*
-     * Process the result from the previous execution of the script body.
-     */
-
-    if (result == TCL_CONTINUE) {
-	result = TCL_OK;
-    } else if (result != TCL_OK) {
-	if (result == TCL_BREAK) {
-	    Tcl_ResetResult(interp);
-	    result = TCL_OK;
-	} else if (result == TCL_ERROR) {
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (\"dict for\" body line %d)",
-		    Tcl_GetErrorLine(interp)));
-	}
-	goto done;
-    }
-
-    /*
-     * Get the next mapping from the dictionary.
-     */
-
-    Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done);
-    if (done) {
-	Tcl_ResetResult(interp);
-	goto 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, TCL_LEAVE_ERR_MSG) == NULL) {
-	TclDecrRefCount(valueObj);
-	result = TCL_ERROR;
-	goto done;
-    }
-    TclDecrRefCount(valueObj);
-    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, TCL_LEAVE_ERR_MSG) == NULL) {
-	result = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Run the script.
-     */
-
-    TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
-	    valueVarObj, scriptObj);
-    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
-
-    /*
-     * For unwinding everything once the iterating is done.
-     */
-
-  done:
-    TclDecrRefCount(keyVarObj);
-    TclDecrRefCount(valueVarObj);
-    TclDecrRefCount(scriptObj);
-    Tcl_DictObjDone(searchPtr);
-    TclStackFree(interp, searchPtr);
-    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 *const filters[] = {
-	"key", "script", "value", NULL
-    };
-    enum FilterTypes {
-	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
-    };
-    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
-    Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
-    Tcl_DictSearch search;
-    int index, varc, done, result, satisfied;
-    const char *pattern;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
-	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:
-	/*
-	 * 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;
-	}
-	if (objc == 3) {
-	    /*
-	     * Nothing to match, so return nothing (== empty dictionary).
-	     */
-
-	    Tcl_DictObjDone(&search);
-	    return TCL_OK;
-	} else if (objc == 4) {
-	    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);
-		}
-	    }
-	} else {
-	    /*
-	     * Can't optimize this match for trivial globbing: would disturb
-	     * order.
-	     */
-
-	    resultObj = Tcl_NewDictObj();
-	    while (!done) {
-		int i;
-
-		for (i=3 ; i<objc ; i++) {
-		    pattern = TclGetString(objv[i]);
-		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
-			Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
-			break;		/* stop inner loop */
-		    }
-		}
-		Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
-	    }
-	}
-	Tcl_SetObjResult(interp, resultObj);
-	return TCL_OK;
-
-    case FILTER_VALUES:
-	/*
-	 * 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;
-	}
-	resultObj = Tcl_NewDictObj();
-	while (!done) {
-	    int i;
-
-	    for (i=3 ; i<objc ; i++) {
-		pattern = TclGetString(objv[i]);
-		if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
-		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
-		    break;		/* stop inner loop */
-		}
-	    }
-	    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)",
-			Tcl_GetErrorLine(interp)));
-	    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, dummy;
-
-    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 after setting up the NRE handler to process the
-     * results.
-     */
-
-    objPtr = Tcl_NewListObj(objc-3, objv+2);
-    Tcl_IncrRefCount(objPtr);
-    Tcl_IncrRefCount(objv[1]);
-    TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);
-
-    return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
-}
-
-static int
-FinalizeDictUpdate(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj *dictPtr, *objPtr, **objv;
-    Tcl_InterpState state;
-    int i, objc;
-    Tcl_Obj *varName = data[0];
-    Tcl_Obj *argsObj = data[1];
-
-    /*
-     * ErrorInfo handling.
-     */
-
-    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, varName, NULL, 0);
-    if (dictPtr == NULL) {
-	TclDecrRefCount(varName);
-	TclDecrRefCount(argsObj);
-	return result;
-    }
-
-    /*
-     * Double-check that it is still a dictionary.
-     */
-
-    state = Tcl_SaveInterpState(interp, result);
-    if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) {
-	Tcl_DiscardInterpState(state);
-	TclDecrRefCount(varName);
-	TclDecrRefCount(argsObj);
-	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.
-     */
-
-    Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
-    for (i=0 ; i<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);
-	}
-    }
-    TclDecrRefCount(argsObj);
-
-    /*
-     * Write the dictionary back to its variable.
-     */
-
-    if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
-	    TCL_LEAVE_ERR_MSG) == NULL) {
-	Tcl_DiscardInterpState(state);
-	TclDecrRefCount(varName);
-	return TCL_ERROR;
-    }
-
-    TclDecrRefCount(varName);
-    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, *pathPtr;
-
-    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;
-    }
-
-    keysPtr = TclDictWithInit(interp, dictPtr, objc-3, objv+2);
-    if (keysPtr == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_IncrRefCount(keysPtr);
-
-    /*
-     * Execute the body, while making the invoking context available to the
-     * loop body (TIP#280) and postponing the cleanup until later (NRE).
-     */
-
-    pathPtr = NULL;
-    if (objc > 3) {
-	pathPtr = Tcl_NewListObj(objc-3, objv+2);
-	Tcl_IncrRefCount(pathPtr);
-    }
-    Tcl_IncrRefCount(objv[1]);
-    TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
-	    NULL);
-
-    return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
-}
-
-static int
-FinalizeDictWith(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj **pathv;
-    int pathc;
-    Tcl_InterpState state;
-    Tcl_Obj *varName = data[0];
-    Tcl_Obj *keysPtr = data[1];
-    Tcl_Obj *pathPtr = data[2];
-    Var *varPtr, *arrayPtr;
-
-    if (result == TCL_ERROR) {
-	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
-    }
-
-    /*
-     * Save the result state; TDWF doesn't guarantee to not modify that on
-     * TCL_OK result.
-     */
-
-    state = Tcl_SaveInterpState(interp, result);
-    if (pathPtr != NULL) {
-	Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
-    } else {
-	pathc = 0;
-	pathv = NULL;
-    }
-
-    /*
-     * Pack from local variables back into the dictionary.
-     */
-
-    varPtr = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG, "set",
-	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-    if (varPtr == NULL) {
-	result = TCL_ERROR;
-    } else {
-	result = TclDictWithFinish(interp, varPtr, arrayPtr, varName, NULL, -1,
-		pathc, pathv, keysPtr);
-    }
-
-    /*
-     * Tidy up and return the real result (unless we had an error).
-     */
-
-    TclDecrRefCount(varName);
-    TclDecrRefCount(keysPtr);
-    if (pathPtr != NULL) {
-	TclDecrRefCount(pathPtr);
-    }
-    if (result != TCL_OK) {
-	Tcl_DiscardInterpState(state);
-	return TCL_ERROR;
-    }
-    return Tcl_RestoreInterpState(interp, state);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDictWithInit --
- *
- *	Part of the core of [dict with]. Pokes into a dictionary and converts
- *	the mappings there into assignments to (presumably) local variables.
- *	Returns a list of all the names that were mapped so that removal of
- *	either the variable or the dictionary entry won't surprise us when we
- *	come to stuffing everything back.
- *
- * Result:
- *	List of mapped names, or NULL if there was an error.
- *
- * Side effects:
- *	Assigns to variables, so potentially legion due to traces.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclDictWithInit(
-    Tcl_Interp *interp,
-    Tcl_Obj *dictPtr,
-    int pathc,
-    Tcl_Obj *const pathv[])
-{
-    Tcl_DictSearch s;
-    Tcl_Obj *keyPtr, *valPtr, *keysPtr;
-    int done;
-
-    if (pathc > 0) {
-	dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
-		DICT_PATH_READ);
-	if (dictPtr == NULL) {
-	    return NULL;
-	}
-    }
-
-    /*
-     * 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 NULL;
-    }
-
-    TclNewObj(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 NULL;
-	}
-    }
-
-    return keysPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDictWithFinish --
- *
- *	Part of the core of [dict with]. Reassembles the piece of the dict (in
- *	varName, location given by pathc/pathv) from the variables named in
- *	the keysPtr argument. NB, does not try to preserve errors or manage
- *	argument lifetimes.
- *
- * Result:
- *	TCL_OK if we succeeded, or TCL_ERROR if we failed.
- *
- * Side effects:
- *	Assigns to a variable, so potentially legion due to traces. Updates
- *	the dictionary in the named variable.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclDictWithFinish(
-    Tcl_Interp *interp,		/* Command interpreter in which variable
-				 * exists. Used for state management, traces
-				 * and error reporting. */
-    Var *varPtr,		/* Reference to the variable holding the
-				 * dictionary. */
-    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. */
-    int index,			/* Index into the local variable table of the
-				 * variable, or -1. Only used when part1Ptr is
-				 * NULL. */
-    int pathc,			/* The number of elements in the path into the
-				 * dictionary. */
-    Tcl_Obj *const pathv[],	/* The elements of the path to the subdict. */
-    Tcl_Obj *keysPtr)		/* List of keys to be synchronized. This is
-				 * the result value from TclDictWithInit. */
-{
-    Tcl_Obj *dictPtr, *leafPtr, *valPtr;
-    int i, allocdict, keyc;
-    Tcl_Obj **keyv;
-
-    /*
-     * If the dictionary variable doesn't exist, drop everything silently.
-     */
-
-    dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-	    TCL_LEAVE_ERR_MSG, index);
-    if (dictPtr == NULL) {
-	return TCL_OK;
-    }
-
-    /*
-     * Double-check that it is still a dictionary.
-     */
-
-    if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    if (Tcl_IsShared(dictPtr)) {
-	dictPtr = Tcl_DuplicateObj(dictPtr);
-	allocdict = 1;
-    } else {
-	allocdict = 0;
-    }
-
-    if (pathc > 0) {
-	/*
-	 * 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, pathc, pathv,
-		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
-	if (leafPtr == NULL) {
-	    if (allocdict) {
-		TclDecrRefCount(dictPtr);
-	    }
-	    return TCL_ERROR;
-	}
-	if (leafPtr == DICT_PATH_NON_EXISTENT) {
-	    if (allocdict) {
-		TclDecrRefCount(dictPtr);
-	    }
-	    return TCL_OK;
-	}
-    } 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);
-	}
-    }
-
-    /*
-     * Ensure that none of the dictionaries in the chain still have a string
-     * rep.
-     */
-
-    if (pathc > 0) {
-	InvalidateDictChain(leafPtr);
-    }
-
-    /*
-     * Write back the outermost dictionary to the variable.
-     */
-
-    if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
-	    TCL_LEAVE_ERR_MSG, index) == NULL) {
-	if (allocdict) {
-	    TclDecrRefCount(dictPtr);
-	}
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 49418c9..73c4067 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -5,41 +5,43 @@
  *
  * 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)(const char *src);
+typedef size_t (LengthProc)_ANSI_ARGS_((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;
-				/* Function to convert from external encoding
-				 * into UTF-8. */
+				/* Procedure to convert from external
+				 * encoding into UTF-8. */
     Tcl_EncodingConvertProc *fromUtfProc;
-				/* Function to convert from UTF-8 into
+				/* Procedure to convert from UTF-8 into
 				 * external encoding. */
     Tcl_EncodingFreeProc *freeProc;
-				/* If non-NULL, function to call when this
+				/* If non-NULL, procedure 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 functions. */
+				 * type.  Passed to conversion procedures. */
     LengthProc *lengthProc;	/* Function to compute length of
 				 * null-terminated strings in this encoding.
 				 * If nullSize is 1, this is strlen; if
@@ -52,15 +54,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,
@@ -68,15 +70,14 @@ 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. */
@@ -84,15 +85,15 @@ 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 {
-    unsigned sequenceLen;	/* Length of following string. */
+    unsigned int sequenceLen;	/* Length of following string. */
     char sequence[16];		/* Escape code that marks this encoding. */
     char name[32];		/* Name for encoding. */
     Encoding *encodingPtr;	/* Encoding loaded using above name, or NULL
@@ -101,25 +102,25 @@ typedef struct EscapeSubTable {
 } EscapeSubTable;
 
 typedef struct EscapeEncodingData {
-    int fallback;		/* Character (in this encoding) to substitute
-				 * when this encoding cannot represent a UTF-8
-				 * character. */
-    unsigned initLen;		/* Length of following string. */
+    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 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. */
+    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. */
     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;
 
 /*
@@ -133,51 +134,27 @@ typedef struct EscapeEncodingData {
 #define ENCODING_ESCAPE		3
 
 /*
- * 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.
- */
-
-static TclInitProcessGlobalValueProc InitializeEncodingSearchPath;
-static ProcessGlobalValue encodingSearchPath = {
-    0, 0, NULL, NULL, InitializeEncodingSearchPath, NULL, NULL
-};
-
-/*
- * 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
-};
-
-/*
- * 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".
+ * 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.
  */
 
-static ProcessGlobalValue libraryPath = {
-    0, 0, NULL, NULL, TclpInitLibraryPath, NULL, NULL
-};
+char *tclDefaultEncodingDir = NULL;
 
-static int encodingsInitialized = 0;
+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 *).
+ * 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;
@@ -191,130 +168,125 @@ static Tcl_Encoding systemEncoding;
 static unsigned short emptyPage[256];
 
 /*
- * Functions used only in this module.
+ * Procedures used only in this module.
  */
 
-static int		BinaryProc(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+static int		BinaryProc _ANSI_ARGS_((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(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
-static void		EscapeFreeProc(ClientData clientData);
-static int		EscapeFromUtfProc(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    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,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr);
-static int		EscapeToUtfProc(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    int *dstCharsPtr));
+static int		EscapeToUtfProc _ANSI_ARGS_((ClientData clientData,
+			    CONST char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    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,
+			    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,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    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,
+			    int *dstCharsPtr));
+static int		TableToUtfProc _ANSI_ARGS_((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(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    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,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr);
-static int		UtfToUtfProc(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    int *dstCharsPtr));
+static int		UtfToUnicodeProc _ANSI_ARGS_((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(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    int *dstCharsPtr));
+static int		UtfToUtfProc _ANSI_ARGS_((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(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    int *dstCharsPtr, int pureNullMode));
+static int		UtfIntToUtfExtProc _ANSI_ARGS_((ClientData clientData,
+			    CONST char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr);
-static int		Iso88591FromUtfProc(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    int *dstCharsPtr));
+static int		UtfExtToUtfIntProc _ANSI_ARGS_((ClientData clientData,
+			    CONST char *src, int srcLen, int flags,
 			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
 			    int *srcReadPtr, int *dstWrotePtr,
-			    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);
+			    int *dstCharsPtr));
+static int		TclFindEncodings _ANSI_ARGS_((CONST char *argv0));
 
 /*
- * A Tcl_ObjType for holding a cached Tcl_Encoding in the otherValuePtr field
- * of the intrep. This should help the lifetime of encodings be more useful.
+ * A Tcl_ObjType for holding a cached Tcl_Encoding as the intrep.
+ * This should help the lifetime of encodings be more useful.  
  * See concerns raised in [Bug 1077262].
  */
 
-static const Tcl_ObjType encodingType = {
+static Tcl_ObjType EncodingType = {
     "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
 };
+
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetEncodingFromObj --
+ * TclGetEncodingFromObj --
  *
- *	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).
+ * 	Caches the Tcl_Encoding value as the internal rep of (*objPtr).
  *
  *----------------------------------------------------------------------
  */
-
-int
-Tcl_GetEncodingFromObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    Tcl_Encoding *encodingPtr)
+int 
+TclGetEncodingFromObj(interp, objPtr, encodingPtr)
+    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;
 	}
-	TclFreeIntRep(objPtr);
-	objPtr->internalRep.otherValuePtr = encoding;
-	objPtr->typePtr = &encodingType;
+	if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) {
+	    objPtr->typePtr->freeIntRepProc(objPtr);
+	}
+	objPtr->internalRep.otherValuePtr = (VOID *) encoding;
+	objPtr->typePtr = &EncodingType;
     }
     *encodingPtr = Tcl_GetEncoding(NULL, name);
     return TCL_OK;
@@ -325,17 +297,15 @@ Tcl_GetEncodingFromObj(
  *
  * FreeEncodingIntRep --
  *
- *	The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
+ *      The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
  *
  *----------------------------------------------------------------------
  */
-
 static void
-FreeEncodingIntRep(
-    Tcl_Obj *objPtr)
+FreeEncodingIntRep(objPtr)
+    Tcl_Obj *objPtr;
 {
-    Tcl_FreeEncoding(objPtr->internalRep.otherValuePtr);
-    objPtr->typePtr = NULL;
+    Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.otherValuePtr);
 }
 
 /*
@@ -343,183 +313,17 @@ FreeEncodingIntRep(
  *
  * DupEncodingIntRep --
  *
- *	The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DupEncodingIntRep(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *dupPtr)
-{
-    dupPtr->internalRep.otherValuePtr = 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.
+ *      The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
  *
  *----------------------------------------------------------------------
  */
-
-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)
+DupEncodingIntRep(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;
+    Tcl_Obj *dupPtr;
 {
-    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, *fileObj;
-
-	    fileObj = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
-	    encodingName = TclPathPart(NULL, fileObj, TCL_PATH_ROOT);
-	    Tcl_DictObjPut(NULL, map, encodingName, directory);
-	    Tcl_DecrRefCount(fileObj);
-	    Tcl_DecrRefCount(encodingName);
-	}
-	Tcl_DecrRefCount(matchFileList);
-	Tcl_DecrRefCount(directory);
-    }
-    Tcl_DecrRefCount(searchPath);
-    TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
-    Tcl_DecrRefCount(map);
+    dupPtr->internalRep.otherValuePtr = (VOID *)
+	    Tcl_GetEncoding(NULL, srcPtr->bytes);
 }
 
 /*
@@ -528,7 +332,7 @@ FillEncodingFileMap(void)
  * TclInitEncodingSubsystem --
  *
  *	Initialize all resources used by this subsystem on a per-process
- *	basis.
+ *	basis.  
  *
  * Results:
  *	None.
@@ -540,25 +344,18 @@ FillEncodingFileMap(void)
  */
 
 void
-TclInitEncodingSubsystem(void)
+TclInitEncodingSubsystem()
 {
     Tcl_EncodingType type;
-    TableEncodingData *dataPtr;
-    unsigned size;
-    unsigned short i;
-
-    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";
@@ -567,7 +364,9 @@ TclInitEncodingSubsystem(void)
     type.freeProc	= NULL;
     type.nullSize	= 1;
     type.clientData	= NULL;
-    Tcl_CreateEncoding(&type);
+
+    defaultEncoding	= Tcl_CreateEncoding(&type);
+    systemEncoding	= Tcl_GetEncoding(NULL, type.encodingName);
 
     type.encodingName	= "utf-8";
     type.toUtfProc	= UtfExtToUtfIntProc;
@@ -584,47 +383,8 @@ TclInitEncodingSubsystem(void)
     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.
-     */
-
-    dataPtr = ckalloc(sizeof(TableEncodingData));
-    memset(dataPtr, 0, sizeof(TableEncodingData));
-    dataPtr->fallback = '?';
-
-    size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
-    dataPtr->toUnicode = ckalloc(size);
-    memset(dataPtr->toUnicode, 0, size);
-    dataPtr->fromUnicode = 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;
-    defaultEncoding	= Tcl_CreateEncoding(&type);
-    systemEncoding	= Tcl_GetEncoding(NULL, type.encodingName);
-
-    encodingsInitialized = 1;
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -643,28 +403,25 @@ TclInitEncodingSubsystem(void)
  */
 
 void
-TclFinalizeEncodingSubsystem(void)
+TclFinalizeEncodingSubsystem()
 {
     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_GetHashValue(hPtr));
+	FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
 	hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     }
-
     Tcl_DeleteHashTable(&encodingTable);
     Tcl_MutexUnlock(&encodingMutex);
 }
@@ -674,32 +431,18 @@ TclFinalizeEncodingSubsystem(void)
  *
  * 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(void)
+CONST char *
+Tcl_GetDefaultEncodingDir()
 {
-    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);
+    return tclDefaultEncodingDir;
 }
 
 /*
@@ -707,28 +450,20 @@ Tcl_GetDefaultEncodingDir(void)
  *
  * 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(
-    const char *path)
+Tcl_SetDefaultEncodingDir(path)
+    CONST char *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);
+    tclDefaultEncodingDir = (char *)ckalloc((unsigned) strlen(path) + 1);
+    strcpy(tclDefaultEncodingDir, path);
 }
 
 /*
@@ -737,29 +472,29 @@ Tcl_SetDefaultEncodingDir(
  * 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
- *	function, 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 procedure, 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(
-    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
-    const char *name)		/* The name of the desired 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_HashEntry *hPtr;
     Encoding *encodingPtr;
@@ -774,13 +509,12 @@ Tcl_GetEncoding(
 
     hPtr = Tcl_FindHashEntry(&encodingTable, name);
     if (hPtr != NULL) {
-	encodingPtr = Tcl_GetHashValue(hPtr);
+	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
 	encodingPtr->refCount++;
 	Tcl_MutexUnlock(&encodingMutex);
 	return (Tcl_Encoding) encodingPtr;
     }
     Tcl_MutexUnlock(&encodingMutex);
-
     return LoadEncodingFile(interp, name);
 }
 
@@ -789,22 +523,22 @@ Tcl_GetEncoding(
  *
  * Tcl_FreeEncoding --
  *
- *	This function is called to release an encoding allocated by
+ *	This procedure 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(
-    Tcl_Encoding encoding)
+Tcl_FreeEncoding(encoding)
+    Tcl_Encoding encoding;
 {
     Tcl_MutexLock(&encodingMutex);
     FreeEncoding(encoding);
@@ -816,25 +550,26 @@ Tcl_FreeEncoding(
  *
  * FreeEncoding --
  *
- *	This function is called to release an encoding by functions that
- *	already have the encodingMutex.
+ *	This procedure is called to release an encoding by procedures
+ *	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(
-    Tcl_Encoding encoding)
+FreeEncoding(encoding)
+    Tcl_Encoding encoding;
 {
-    Encoding *encodingPtr = (Encoding *) encoding;
-
+    Encoding *encodingPtr;
+    
+    encodingPtr = (Encoding *) encoding;
     if (encodingPtr == NULL) {
 	return;
     }
@@ -844,13 +579,13 @@ FreeEncoding(
     encodingPtr->refCount--;
     if (encodingPtr->refCount == 0) {
 	if (encodingPtr->freeProc != NULL) {
-	    encodingPtr->freeProc(encodingPtr->clientData);
+	    (*encodingPtr->freeProc)(encodingPtr->clientData);
 	}
 	if (encodingPtr->hPtr != NULL) {
 	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
 	}
-	ckfree(encodingPtr->name);
-	ckfree(encodingPtr);
+	ckfree((char *) encodingPtr->name);
+	ckfree((char *) encodingPtr);
     }
 }
 
@@ -859,8 +594,8 @@ FreeEncoding(
  *
  * 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.
@@ -871,15 +606,17 @@ FreeEncoding(
  *---------------------------------------------------------------------------
  */
 
-const char *
-Tcl_GetEncodingName(
-    Tcl_Encoding encoding)	/* The encoding whose name to fetch. */
+CONST char *
+Tcl_GetEncodingName(encoding)
+    Tcl_Encoding encoding;	/* The encoding whose name to fetch. */
 {
+    Encoding *encodingPtr;
+
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
-
-    return ((Encoding *) encoding)->name;
+    encodingPtr = (Encoding *) encoding;
+    return encodingPtr->name;
 }
 
 /*
@@ -887,8 +624,8 @@ Tcl_GetEncodingName(
  *
  * 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
@@ -901,54 +638,102 @@ Tcl_GetEncodingName(
  */
 
 void
-Tcl_GetEncodingNames(
-    Tcl_Interp *interp)		/* Interp to hold result. */
+Tcl_GetEncodingNames(interp)
+    Tcl_Interp *interp;		/* Interp to hold result. */
 {
-    Tcl_HashTable table;
     Tcl_HashSearch search;
     Tcl_HashEntry *hPtr;
-    Tcl_Obj *map, *name, *result = Tcl_NewObj();
-    Tcl_DictSearch mapSearch;
-    int dummy, done = 0;
-
-    Tcl_InitObjHashTable(&table);
+    Tcl_Obj *pathPtr, *resultPtr;
+    int dummy;
 
-    /*
-     * Copy encoding names from loaded encoding table to table.
-     */
+    Tcl_HashTable table;
 
     Tcl_MutexLock(&encodingMutex);
-    for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&search)) {
-	Encoding *encodingPtr = Tcl_GetHashValue(hPtr);
-
-	Tcl_CreateHashEntry(&table,
-		Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
+    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);
     }
     Tcl_MutexUnlock(&encodingMutex);
 
-    FillEncodingFileMap();
-    map = TclGetProcessGlobalValue(&encodingFileMap);
+    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);
 
-    /*
-     * Copy encoding names from encoding file map to table.
-     */
+	    /*
+	     * 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.
+	     */
 
-    Tcl_DictObjFirst(NULL, map, &mapSearch, &name, NULL, &done);
-    for (; !done; Tcl_DictObjNext(&mapSearch, &name, NULL, &done)) {
-	Tcl_CreateHashEntry(&table, name, &dummy);
+	    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);
     }
 
     /*
-     * Pull all encoding names from table into the result list.
+     * Clear any values placed in the result by globbing.
      */
 
-    for (hPtr = Tcl_FirstHashEntry(&table, &search); hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&search)) {
-	Tcl_ListObjAppendElement(NULL, result,
-		(Tcl_Obj *) Tcl_GetHashKey(&table, hPtr));
+    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);
     }
-    Tcl_SetObjResult(interp, result);
     Tcl_DeleteHashTable(&table);
 }
 
@@ -957,29 +742,29 @@ Tcl_GetEncodingNames(
  *
  * 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(
-    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
-    const char *name)		/* The name of the desired encoding, or NULL/""
+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/""
 				 * to reset to default encoding. */
 {
     Tcl_Encoding encoding;
@@ -1011,52 +796,51 @@ Tcl_SetSystemEncoding(
  *
  * Tcl_CreateEncoding --
  *
- *	This function is called to define a new encoding and the functions
- *	that are used to convert between the specified encoding and Unicode.
+ *	This procedure is called to define a new encoding and the procedures
+ *	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
- *	function, 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 procedure, 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(
-    const Tcl_EncodingType *typePtr)
-				/* The encoding type. */
+Tcl_CreateEncoding(typePtr)
+    Tcl_EncodingType *typePtr;	/* The encoding type. */
 {
     Tcl_HashEntry *hPtr;
-    int isNew;
+    int new;
     Encoding *encodingPtr;
     char *name;
 
     Tcl_MutexLock(&encodingMutex);
-    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
-    if (isNew == 0) {
+    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &new);
+    if (new == 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 = Tcl_GetHashValue(hPtr);
+	 
+	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
 	encodingPtr->hPtr = NULL;
     }
 
-    name = ckalloc(strlen(typePtr->encodingName) + 1);
-
-    encodingPtr = ckalloc(sizeof(Encoding));
+    name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);
+    
+    encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
     encodingPtr->name		= strcpy(name, typePtr->encodingName);
     encodingPtr->toUtfProc	= typePtr->toUtfProc;
     encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
@@ -1082,15 +866,15 @@ Tcl_CreateEncoding(
  *
  * 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.
@@ -1098,25 +882,25 @@ Tcl_CreateEncoding(
  *-------------------------------------------------------------------------
  */
 
-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
+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
 				 * 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;
-    const Encoding *encodingPtr;
+    Encoding *encodingPtr;
     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
 
     Tcl_DStringInit(dstPtr);
     dst = Tcl_DStringValue(dstPtr);
     dstLen = dstPtr->spaceAvl - 1;
-
+    
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
@@ -1125,21 +909,18 @@ Tcl_ExternalToUtfDString(
     if (src == NULL) {
 	srcLen = 0;
     } else if (srcLen < 0) {
-	srcLen = encodingPtr->lengthProc(src);
+	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);
+	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;
@@ -1161,49 +942,50 @@ Tcl_ExternalToUtfDString(
  *
  * 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(
-    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(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
 				 * 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. */
 {
-    const Encoding *encodingPtr;
+    Encoding *encodingPtr;
     int result, srcRead, dstWrote, dstChars;
     Tcl_EncodingState state;
-
+    
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
@@ -1212,7 +994,7 @@ Tcl_ExternalToUtf(
     if (src == NULL) {
 	srcLen = 0;
     } else if (srcLen < 0) {
-	srcLen = encodingPtr->lengthProc(src);
+	srcLen = (*encodingPtr->lengthProc)(src);
     }
     if (statePtr == NULL) {
 	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
@@ -1230,16 +1012,15 @@ Tcl_ExternalToUtf(
 
     /*
      * 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--;
-    result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
+    result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src, srcLen,
 	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
 	    dstCharsPtr);
     dst[*dstWrotePtr] = '\0';
-
     return result;
 }
 
@@ -1248,15 +1029,15 @@ Tcl_ExternalToUtf(
  *
  * 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.
@@ -1265,20 +1046,20 @@ Tcl_ExternalToUtf(
  */
 
 char *
-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
+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
 				 * 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;
-    const Encoding *encodingPtr;
+    Encoding *encodingPtr;
     int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
-
+    
     Tcl_DStringInit(dstPtr);
     dst = Tcl_DStringValue(dstPtr);
     dstLen = dstPtr->spaceAvl - 1;
@@ -1295,19 +1076,17 @@ Tcl_UtfToExternalDString(
     }
     flags = TCL_ENCODING_START | TCL_ENCODING_END;
     while (1) {
-	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
+	result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src,
 		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;
@@ -1329,49 +1108,50 @@ Tcl_UtfToExternalDString(
  *
  * 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(
-    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(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
 				 * 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. */
 {
-    const Encoding *encodingPtr;
+    Encoding *encodingPtr;
     int result, srcRead, dstWrote, dstChars;
     Tcl_EncodingState state;
-
+    
     if (encoding == NULL) {
 	encoding = systemEncoding;
     }
@@ -1397,14 +1177,14 @@ Tcl_UtfToExternal(
     }
 
     dstLen -= encodingPtr->nullSize;
-    result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
+    result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src, srcLen,
 	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
 	    dstCharsPtr);
     if (encodingPtr->nullSize == 2) {
 	dst[*dstWrotePtr + 1] = '\0';
     }
     dst[*dstWrotePtr] = '\0';
-
+    
     return result;
 }
 
@@ -1413,143 +1193,78 @@ Tcl_UtfToExternal(
  *
  * Tcl_FindExecutable --
  *
- *	This function computes the absolute path name of the current
+ *	This procedure computes the absolute path name of the current
  *	application, given its argv[0] value.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The absolute pathname for the application is computed and stored to be
- *	returned later be [info nameofexecutable].
+ *	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.
  *
  *---------------------------------------------------------------------------
  */
-#undef Tcl_FindExecutable
+
 void
-Tcl_FindExecutable(
-    const char *argv0)		/* The value of the application's argv[0]
+Tcl_FindExecutable(argv0)
+    CONST char *argv0;		/* The value of the application's argv[0]
 				 * (native). */
 {
-    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.
- *
- *---------------------------------------------------------------------------
- */
+    int mustCleanUtf;
+    CONST char *name;
+    Tcl_DString buffer, nameString;
 
-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);
-
-    /*
-     * Check that any cached directory is still on the encoding search path.
-     */
+    TclInitSubsystems(argv0);
 
-    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 (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);
+    if (tclExecutableName != NULL) {
+	ckfree(tclExecutableName);
+	tclExecutableName = NULL;
+    }
+    if ((name = TclpFindExecutable(argv0)) == NULL) {
+	goto done;
     }
 
     /*
-     * Scan the search path until we find it.
+     * 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.
      */
+    
+    Tcl_UtfToExternalDString(NULL, name, -1, &buffer);
+    mustCleanUtf = 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;
+    /*
+     * 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);
 }
 
 /*
@@ -1557,34 +1272,50 @@ OpenEncodingFileChannel(
  *
  * 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(
-    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(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. */
 {
-    Tcl_Channel chan = NULL;
-    Tcl_Encoding encoding = NULL;
-    int ch;
+    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;
+	}
+    }
 
-    chan = OpenEncodingFileChannel(interp, name);
     if (chan == NULL) {
-	return NULL;
+	goto unknown;
     }
 
     Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
@@ -1601,27 +1332,89 @@ LoadEncodingFile(
 	}
     }
 
+    encoding = NULL;
     switch (ch) {
-    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;
+	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;
+	}
     }
     if ((encoding == NULL) && (interp != NULL)) {
 	Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", 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;
 }
 
 /*
@@ -1629,17 +1422,17 @@ LoadEncodingFile(
  *
  * 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.
@@ -1648,19 +1441,20 @@ LoadEncodingFile(
  */
 
 static Tcl_Encoding
-LoadTableEncoding(
-    const char *name,		/* Name for new encoding. */
-    int type,			/* Type of encoding (ENCODING_?????). */
-    Tcl_Channel chan)		/* File containing new 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. */
 {
     Tcl_DString lineString;
     Tcl_Obj *objPtr;
     char *line;
-    int i, hi, lo, numPages, symbol, fallback, len;
+    int i, hi, lo, numPages, symbol, fallback;
     unsigned char used[256];
-    unsigned size;
+    unsigned int size;
     TableEncodingData *dataPtr;
-    unsigned short *pageMemPtr, *page;
+    unsigned short *pageMemPtr;
     Tcl_EncodingType encType;
 
     /*
@@ -1668,7 +1462,7 @@ LoadTableEncoding(
      * 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 */
@@ -1707,39 +1501,42 @@ LoadTableEncoding(
 #undef PAGESIZE
 #define PAGESIZE    (256 * sizeof(unsigned short))
 
-    dataPtr = ckalloc(sizeof(TableEncodingData));
+    dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
     memset(dataPtr, 0, sizeof(TableEncodingData));
 
     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;
-    dataPtr->toUnicode = ckalloc(size);
+    dataPtr->toUnicode = (unsigned short **) ckalloc(size);
     memset(dataPtr->toUnicode, 0, size);
     pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);
 
-    TclNewObj(objPtr);
-    Tcl_IncrRefCount(objPtr);
+    if (interp == NULL) {
+	objPtr = Tcl_NewObj();
+    } else {
+	objPtr = Tcl_GetObjResult(interp);
+    }
     for (i = 0; i < numPages; i++) {
 	int ch;
-	const char *p;
+	char *p;
 
 	Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
 	p = Tcl_GetString(objPtr);
-	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
+	hi = (staticHex[(unsigned int)p[0]] << 4) + staticHex[(unsigned int)p[1]];
 	dataPtr->toUnicode[hi] = pageMemPtr;
 	p += 2;
 	for (lo = 0; lo < 256; lo++) {
 	    if ((lo & 0x0f) == 0) {
 		p++;
 	    }
-	    ch = (staticHex[UCHAR(p[0])] << 12) + (staticHex[UCHAR(p[1])] << 8)
-		    + (staticHex[UCHAR(p[2])] << 4) + staticHex[UCHAR(p[3])];
+	    ch = (staticHex[(unsigned int)p[0]] << 12) + (staticHex[(unsigned int)p[1]] << 8)
+		+ (staticHex[(unsigned int)p[2]] << 4) + staticHex[(unsigned int)p[3]];
 	    if (ch != 0) {
 		used[ch >> 8] = 1;
 	    }
@@ -1748,8 +1545,12 @@ LoadTableEncoding(
 	    p += 4;
 	}
     }
-    TclDecrRefCount(objPtr);
-
+    if (interp == NULL) {
+	Tcl_DecrRefCount(objPtr);
+    } else {
+	Tcl_ResetResult(interp);
+    }
+	
     if (type == ENCODING_DOUBLEBYTE) {
 	memset(dataPtr->prefixBytes, 1, sizeof(dataPtr->prefixBytes));
     } else {
@@ -1761,10 +1562,10 @@ LoadTableEncoding(
     }
 
     /*
-     * 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) {
@@ -1777,33 +1578,36 @@ LoadTableEncoding(
 	}
     }
     size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
-    dataPtr->fromUnicode = ckalloc(size);
+    dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
     memset(dataPtr->fromUnicode, 0, size);
     pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);
 
     for (hi = 0; hi < 256; hi++) {
 	if (dataPtr->toUnicode[hi] == NULL) {
 	    dataPtr->toUnicode[hi] = emptyPage;
-	    continue;
-	}
-	for (lo = 0; lo < 256; lo++) {
-	    int ch = dataPtr->toUnicode[hi][lo];
-
-	    if (ch != 0) {
-		page = dataPtr->fromUnicode[ch >> 8];
-		if (page == NULL) {
-		    page = pageMemPtr;
-		    pageMemPtr += 256;
-		    dataPtr->fromUnicode[ch >> 8] = page;
+	} else {
+	    for (lo = 0; lo < 256; lo++) {
+		int ch;
+
+		ch = dataPtr->toUnicode[hi][lo];
+		if (ch != 0) {
+		    unsigned short *page;
+		    
+		    page = dataPtr->fromUnicode[ch >> 8];
+		    if (page == NULL) {
+			page = pageMemPtr;
+			pageMemPtr += 256;
+			dataPtr->fromUnicode[ch >> 8] = page;
+		    }
+		    page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
 		}
-		page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
 	    }
 	}
     }
     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.
 	 */
@@ -1815,14 +1619,17 @@ LoadTableEncoding(
 	}
     }
     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];
@@ -1841,84 +1648,54 @@ LoadTableEncoding(
 	    dataPtr->fromUnicode[hi] = emptyPage;
 	}
     }
-
     /*
-     * For trailing 'R'everse encoding, see [Patch 689341]
+     * For trailing 'R'everse encoding, see [Patch #689341]
      */
-
     Tcl_DStringInit(&lineString);
-
-    /*
-     * Skip leading empty lines.
-     */
-
-    while ((len = Tcl_Gets(chan, &lineString)) == 0) {
-	/* empty body */
-    }
-    if (len < 0) {
-	goto doneParse;
-    }
-
-    /*
-     * Require that it starts with an 'R'.
-     */
-
-    line = Tcl_DStringValue(&lineString);
-    if (line[0] != 'R') {
-	goto doneParse;
-    }
-
-    /*
-     * Read lines from the encoding until EOF.
-     */
-
-    for (Tcl_DStringSetLength(&lineString, 0);
-	    (len = Tcl_Gets(chan, &lineString)) >= 0;
-	    Tcl_DStringSetLength(&lineString, 0)) {
-	const unsigned char *p;
-	int to, from;
-
-	/*
-	 * Skip short lines.
-	 */
-
-	if (len < 5) {
-	    continue;
+    do {
+	int len;
+	/* skip leading empty lines */
+	while ((len = Tcl_Gets(chan, &lineString)) == 0)
+	    ;
+	if (len < 0) {
+	    break;
 	}
-
-	/*
-	 * Parse the line as a sequence of hex digits.
-	 */
-
-	p = (const unsigned char *) Tcl_DStringValue(&lineString);
-	to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
-		+ (staticHex[p[2]] << 4) + staticHex[p[3]];
-	if (to == 0) {
-	    continue;
+	line = Tcl_DStringValue(&lineString);
+	if (line[0] != 'R') {
+	    break;
 	}
-	for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
-	    from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
-		    + (staticHex[p[2]] << 4) + staticHex[p[3]];
-	    if (from == 0) {
+	for (Tcl_DStringSetLength(&lineString, 0);
+	     (len = Tcl_Gets(chan, &lineString)) >= 0;
+	     Tcl_DStringSetLength(&lineString, 0)) {
+	    unsigned char* p;
+	    int to, from;
+	    if (len < 5) {
 		continue;
 	    }
-	    dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
+	    p = (unsigned char*) Tcl_DStringValue(&lineString);
+	    to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
+		+ (staticHex[p[2]] << 4) + staticHex[p[3]];
+	    if (to == 0) {
+	    	continue;
+	    }
+	    for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
+		from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
+			+ (staticHex[p[2]] << 4) + staticHex[p[3]];
+	    	if (from == 0) {
+		    continue;
+		}
+		dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
+	    }
 	}
-    }
-  doneParse:
+    } while (0);
     Tcl_DStringFree(&lineString);
 
-    /*
-     * Package everything into an encoding structure.
-     */
-
     encType.encodingName    = name;
     encType.toUtfProc	    = TableToUtfProc;
     encType.fromUtfProc	    = TableFromUtfProc;
     encType.freeProc	    = TableFreeProc;
     encType.nullSize	    = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
-    encType.clientData	    = dataPtr;
-
+    encType.clientData	    = (ClientData) dataPtr;
     return Tcl_CreateEncoding(&encType);
 }
 
@@ -1927,16 +1704,16 @@ LoadTableEncoding(
  *
  * 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.
@@ -1945,12 +1722,12 @@ LoadTableEncoding(
  */
 
 static Tcl_Encoding
-LoadEscapeEncoding(
-    const char *name,		/* Name for new encoding. */
-    Tcl_Channel chan)		/* File containing new encoding. */
+LoadEscapeEncoding(name, chan)
+    CONST char *name;		/* Name for new encoding. */
+    Tcl_Channel chan;		/* File containing new encoding. */
 {
-    int i;
-    unsigned size;
+    int i, missingSubEncoding = 0;
+    unsigned int size;
     Tcl_DString escapeData;
     char init[16], final[16];
     EscapeEncodingData *dataPtr;
@@ -1962,22 +1739,21 @@ LoadEscapeEncoding(
 
     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) {
-	    Tcl_DStringFree(&lineString);
+        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';
@@ -1986,7 +1762,6 @@ LoadEscapeEncoding(
 		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';
@@ -1996,33 +1771,36 @@ LoadEscapeEncoding(
 		est.name[sizeof(est.name) - 1] = '\0';
 
 		/*
-		 * To avoid infinite recursion in [encoding system iso2022-*]
+		 * Load the subencodings first so we're never stuck
+		 * trying to use a half-loaded system encoding to
+		 * open/read a *.enc file.
 		 */
 
-		e = (Encoding *) Tcl_GetEncoding(NULL, est.name);
-		if ((e != NULL) && (e->toUtfProc != TableToUtfProc)
-			&& (e->toUtfProc != Iso88591ToUtfProc)) {
-		   Tcl_FreeEncoding((Tcl_Encoding) e);
-		   e = NULL;
+		est.encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, est.name);
+		if ((est.encodingPtr == NULL) 
+			|| (est.encodingPtr->toUtfProc != TableToUtfProc)) {
+		    missingSubEncoding = 1;
 		}
-		est.encodingPtr = e;
 		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
 	    }
 	}
-	ckfree(argv);
+	ckfree((char *) argv);
 	Tcl_DStringFree(&lineString);
     }
+    if (missingSubEncoding) {
+	Tcl_DStringFree(&escapeData);
+	return NULL;
+    }
 
-    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
-	    + Tcl_DStringLength(&escapeData);
-    dataPtr = ckalloc(size);
+    size = sizeof(EscapeEncodingData)
+	    - sizeof(EscapeSubTable) + Tcl_DStringLength(&escapeData);
+    dataPtr = (EscapeEncodingData *) ckalloc(size);
     dataPtr->initLen = strlen(init);
-    memcpy(dataPtr->init, init, (unsigned) dataPtr->initLen + 1);
+    strcpy(dataPtr->init, init);
     dataPtr->finalLen = strlen(final);
-    memcpy(dataPtr->final, final, (unsigned) dataPtr->finalLen + 1);
-    dataPtr->numSubTables =
-	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
-    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
+    strcpy(dataPtr->final, final);
+    dataPtr->numSubTables = Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
+    memcpy((VOID *) dataPtr->subTables, (VOID *) Tcl_DStringValue(&escapeData),
 	    (size_t) Tcl_DStringLength(&escapeData));
     Tcl_DStringFree(&escapeData);
 
@@ -2037,16 +1815,12 @@ LoadEscapeEncoding(
 	dataPtr->prefixBytes[UCHAR(dataPtr->final[0])] = 1;
     }
 
-    /*
-     * Package everything into an encoding structure.
-     */
-
     type.encodingName	= name;
     type.toUtfProc	= EscapeToUtfProc;
     type.fromUtfProc    = EscapeFromUtfProc;
     type.freeProc	= EscapeFreeProc;
     type.nullSize	= 1;
-    type.clientData	= dataPtr;
+    type.clientData	= (ClientData) dataPtr;
 
     return Tcl_CreateEncoding(&type);
 }
@@ -2056,9 +1830,9 @@ LoadEscapeEncoding(
  *
  * 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.
@@ -2070,26 +1844,27 @@ LoadEscapeEncoding(
  */
 
 static int
-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
+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
 				 * 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. */
 {
@@ -2108,17 +1883,18 @@ BinaryProc(
     *srcReadPtr = srcLen;
     *dstWrotePtr = srcLen;
     *dstCharsPtr = srcLen;
-    memcpy(dst, src, (size_t) srcLen);
+    memcpy((void *) dst, (void *) 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:
@@ -2129,36 +1905,36 @@ BinaryProc(
  *
  *-------------------------------------------------------------------------
  */
-
-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
+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
 				 * 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);
 }
 
 /*
@@ -2166,9 +1942,9 @@ UtfIntToUtfExtProc(
  *
  * 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.
@@ -2178,36 +1954,36 @@ UtfIntToUtfExtProc(
  *
  *-------------------------------------------------------------------------
  */
-
-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
+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
 				 * 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);
 }
 
 /*
@@ -2215,9 +1991,9 @@ UtfExtToUtfIntProc(
  *
  * 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.
@@ -2228,43 +2004,45 @@ UtfExtToUtfIntProc(
  *-------------------------------------------------------------------------
  */
 
-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
+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
 				 * 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 *dstStart, *dstEnd;
+    CONST char *srcStart, *srcEnd, *srcClose;
+    char *dstStart, *dstEnd;
     int result, numChars;
     Tcl_UniChar ch;
 
     result = TCL_OK;
-
+    
     srcStart = src;
     srcEnd = src + srcLen;
     srcClose = srcEnd;
@@ -2289,26 +2067,26 @@ UtfToUtfProc(
 	    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 byts 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 bytes are made to
+	     * represent themselves.
 	     */
 
 	    ch = (unsigned char) *src;
@@ -2320,7 +2098,7 @@ UtfToUtfProc(
 	}
     }
 
-    *srcReadPtr = src - srcStart;
+    *srcReadPtr  = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
     return result;
@@ -2342,35 +2120,36 @@ UtfToUtfProc(
  *-------------------------------------------------------------------------
  */
 
-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
+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
 				 * 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 *dstEnd, *dstStart;
+    CONST char *srcStart, *srcEnd;
+    char *dstEnd, *dstStart;
     int result, numChars;
     Tcl_UniChar ch;
 
@@ -2392,12 +2171,10 @@ UnicodeToUtfProc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-
 	/*
-	 * Special case for 1-byte utf chars for speed. Make sure we work with
-	 * Tcl_UniChar-size data.
+	 * Special case for 1-byte utf chars for speed.  Make sure we
+	 * work with Tcl_UniChar-size data.
 	 */
-
 	ch = *(Tcl_UniChar *)src;
 	if (ch && ch < 0x80) {
 	    *dst++ = (ch & 0xFF);
@@ -2429,35 +2206,35 @@ UnicodeToUtfProc(
  *-------------------------------------------------------------------------
  */
 
-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
+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
 				 * 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;
 
@@ -2487,13 +2264,11 @@ UtfToUnicodeProc(
 	    break;
         }
 	src += TclUtfToUniChar(src, &ch);
-
 	/*
-	 * Need to handle this in a way that won't cause misalignment by
-	 * casting dst to a Tcl_UniChar. [Bug 1122671]
+	 * Need to handle this in a way that won't cause misalignment
+	 * by casting dst to a Tcl_UniChar. [Bug 1122671]
 	 * XXX: This hard-codes the assumed size of Tcl_UniChar as 2.
 	 */
-
 #ifdef WORDS_BIGENDIAN
 	*dst++ = (ch >> 8);
 	*dst++ = (ch & 0xFF);
@@ -2525,58 +2300,60 @@ UtfToUnicodeProc(
  *-------------------------------------------------------------------------
  */
 
-static int
-TableToUtfProc(
-    ClientData clientData,	/* TableEncodingData that specifies
+static int 
+TableToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+	srcReadPtr, dstWrotePtr, dstCharsPtr)
+    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 *dstEnd, *dstStart, *prefixBytes;
+    CONST char *srcStart, *srcEnd;
+    char *dstEnd, *dstStart, *prefixBytes;
     int result, byte, numChars;
     Tcl_UniChar ch;
-    const unsigned short *const *toUnicode;
-    const unsigned short *pageZero;
-    TableEncodingData *dataPtr = clientData;
-
+    unsigned short **toUnicode;
+    unsigned short *pageZero;
+    TableEncodingData *dataPtr;
+    
     srcStart = src;
     srcEnd = src + srcLen;
 
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
-    toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
+    dataPtr = (TableEncodingData *) clientData;
+    toUnicode = dataPtr->toUnicode;
     prefixBytes = dataPtr->prefixBytes;
     pageZero = toUnicode[0];
 
     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++;
@@ -2599,19 +2376,16 @@ TableToUtfProc(
 	    }
 	    ch = (Tcl_UniChar) byte;
 	}
-
 	/*
 	 * Special case for 1-byte utf chars for speed.
 	 */
-
 	if (ch && ch < 0x80) {
 	    *dst++ = (char) ch;
 	} else {
 	    dst += Tcl_UniCharToUtf(ch, dst);
 	}
-	src++;
+        src++;
     }
-
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -2635,46 +2409,48 @@ TableToUtfProc(
  *-------------------------------------------------------------------------
  */
 
-static int
-TableFromUtfProc(
-    ClientData clientData,	/* TableEncodingData that specifies
+static int 
+TableFromUtfProc(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
+    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 *dstStart, *dstEnd, *prefixBytes;
+    CONST char *srcStart, *srcEnd, *srcClose;
+    char *dstStart, *dstEnd, *prefixBytes;
     Tcl_UniChar ch;
     int result, len, word, numChars;
-    TableEncodingData *dataPtr = clientData;
-    const unsigned short *const *fromUnicode;
-
-    result = TCL_OK;
+    TableEncodingData *dataPtr;
+    unsigned short **fromUnicode;
+    
+    result = TCL_OK;    
 
+    dataPtr = (TableEncodingData *) clientData;
     prefixBytes = dataPtr->prefixBytes;
-    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;
-
+    fromUnicode = dataPtr->fromUnicode;
+    
     srcStart = src;
     srcEnd = src + srcLen;
     srcClose = srcEnd;
@@ -2699,10 +2475,9 @@ TableFromUtfProc(
 
 #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
@@ -2714,7 +2489,7 @@ TableFromUtfProc(
 		result = TCL_CONVERT_UNKNOWN;
 		break;
 	    }
-	    word = dataPtr->fallback;
+	    word = dataPtr->fallback; 
 	}
 	if (prefixBytes[(word >> 8)] != 0) {
 	    if (dst + 1 > dstEnd) {
@@ -2731,196 +2506,9 @@ TableFromUtfProc(
 	    }
 	    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;
-    const 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;
-    const 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;
@@ -2932,8 +2520,8 @@ Iso88591FromUtfProc(
  *
  * TableFreeProc --
  *
- *	This function is invoked when an encoding is deleted. It deletes the
- *	memory used by the TableEncodingData.
+ *	This procedure is invoked when an encoding is deleted.  It deletes
+ *	the memory used by the TableEncodingData.
  *
  * Results:
  *	None.
@@ -2945,19 +2533,20 @@ Iso88591FromUtfProc(
  */
 
 static void
-TableFreeProc(
-    ClientData clientData)	/* TableEncodingData that specifies
+TableFreeProc(clientData)
+    ClientData clientData;	/* TableEncodingData that specifies
 				 * encoding. */
 {
-    TableEncodingData *dataPtr = clientData;
+    TableEncodingData *dataPtr;
 
     /*
-     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
+     * Make sure we aren't freeing twice on shutdown.  [Bug #219314]
      */
 
-    ckfree(dataPtr->toUnicode);
-    ckfree(dataPtr->fromUnicode);
-    ckfree(dataPtr);
+    dataPtr = (TableEncodingData *) clientData;
+    ckfree((char *) dataPtr->toUnicode);
+    ckfree((char *) dataPtr->fromUnicode);
+    ckfree((char *) dataPtr);
 }
 
 /*
@@ -2977,44 +2566,49 @@ TableFreeProc(
  *-------------------------------------------------------------------------
  */
 
-static int
-EscapeToUtfProc(
-    ClientData clientData,	/* EscapeEncodingData that specifies
+static int 
+EscapeToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+	srcReadPtr, dstWrotePtr, dstCharsPtr)
+    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. */
 {
-    EscapeEncodingData *dataPtr = clientData;
-    const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
-    const unsigned short *const *tableToUnicode;
-    const Encoding *encodingPtr;
+    EscapeEncodingData *dataPtr;
+    char *prefixBytes, *tablePrefixBytes;
+    unsigned short **tableToUnicode;
+    Encoding *encodingPtr;
     int state, result, numChars;
-    const char *dstStart, *dstEnd;
+    CONST char *srcStart, *srcEnd;
+    char *dstStart, *dstEnd;
 
     result = TCL_OK;
+
     tablePrefixBytes = NULL;	/* lint. */
     tableToUnicode = NULL;	/* lint. */
+
+    dataPtr = (EscapeEncodingData *) clientData;
     prefixBytes = dataPtr->prefixBytes;
     encodingPtr = NULL;
 
@@ -3024,7 +2618,7 @@ EscapeToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
-    state = PTR2INT(*statePtr);
+    state = (int) *statePtr;
     if (flags & TCL_ENCODING_START) {
 	state = 0;
     }
@@ -3032,56 +2626,54 @@ EscapeToUtfProc(
     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 left, len, longest;
+	    unsigned int left, len, longest;
 	    int checked, i;
-	    const EscapeSubTable *subTablePtr;
-
+	    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;
@@ -3090,7 +2682,7 @@ EscapeToUtfProc(
 		}
 		if (len <= left) {
 		    checked++;
-		    if ((len > 0) &&
+		    if ((len > 0) && 
 			    (memcmp(src, subTablePtr->sequence, len) == 0)) {
 			state = i;
 			encodingPtr = NULL;
@@ -3101,7 +2693,6 @@ EscapeToUtfProc(
 		}
 		subTablePtr++;
 	    }
-
 	    if (subTablePtr == NULL) {
 		/*
 		 * A match was found, the escape sequence was consumed, and
@@ -3112,9 +2703,9 @@ EscapeToUtfProc(
 	    }
 
 	    /*
-	     * 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)
@@ -3138,12 +2729,10 @@ EscapeToUtfProc(
 	    TableEncodingData *tableDataPtr;
 
 	    encodingPtr = GetTableEncoding(dataPtr, state);
-	    tableDataPtr = encodingPtr->clientData;
+	    tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
 	    tablePrefixBytes = tableDataPtr->prefixBytes;
-	    tableToUnicode = (const unsigned short *const*)
-		    tableDataPtr->toUnicode;
+	    tableToUnicode = tableDataPtr->toUnicode;
 	}
-
 	if (tablePrefixBytes[byte]) {
 	    src++;
 	    if (src >= srcEnd) {
@@ -3157,14 +2746,13 @@ EscapeToUtfProc(
 	    hi = 0;
 	    lo = byte;
 	}
-
 	ch = tableToUnicode[hi][lo];
 	dst += Tcl_UniCharToUtf(ch, dst);
 	src++;
 	numChars++;
     }
 
-    *statePtr = (Tcl_EncodingState) INT2PTR(state);
+    *statePtr = (Tcl_EncodingState) state;
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -3188,44 +2776,47 @@ EscapeToUtfProc(
  *-------------------------------------------------------------------------
  */
 
-static int
-EscapeFromUtfProc(
-    ClientData clientData,	/* EscapeEncodingData that specifies
+static int 
+EscapeFromUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
+	srcReadPtr, dstWrotePtr, dstCharsPtr)
+    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 = clientData;
-    const Encoding *encodingPtr;
-    const char *srcStart, *srcEnd, *srcClose;
-    const char *dstStart, *dstEnd;
+    EscapeEncodingData *dataPtr;
+    Encoding *encodingPtr;
+    CONST char *srcStart, *srcEnd, *srcClose;
+    char *dstStart, *dstEnd;
     int state, result, numChars;
-    const TableEncodingData *tableDataPtr;
-    const char *tablePrefixBytes;
-    const unsigned short *const *tableFromUnicode;
+    TableEncodingData *tableDataPtr;
+    char *tablePrefixBytes;
+    unsigned short **tableFromUnicode;
+    
+    result = TCL_OK;    
 
-    result = TCL_OK;
+    dataPtr = (EscapeEncodingData *) clientData;
 
     srcStart = src;
     srcEnd = src + srcLen;
@@ -3238,8 +2829,8 @@ EscapeFromUtfProc(
     dstEnd = dst + dstLen - 1;
 
     /*
-     * RFC 1468 states that the text starts in ASCII, and switches to Japanese
-     * characters, and that the text must end in ASCII. [Patch 474358]
+     * RFC1468 states that the text starts in ASCII, and switches to Japanese
+     * characters, and that the text must end in ASCII. [Patch #474358]
      */
 
     if (flags & TCL_ENCODING_START) {
@@ -3249,23 +2840,23 @@ EscapeFromUtfProc(
 	    *dstWrotePtr = 0;
 	    return TCL_CONVERT_NOSPACE;
 	}
-	memcpy(dst, dataPtr->init, (size_t)dataPtr->initLen);
+	memcpy((VOID *) dst, (VOID *) dataPtr->init,
+		(size_t) dataPtr->initLen);
 	dst += dataPtr->initLen;
     } else {
-	state = PTR2INT(*statePtr);
+        state = (int) *statePtr;
     }
 
     encodingPtr = GetTableEncoding(dataPtr, state);
-    tableDataPtr = encodingPtr->clientData;
+    tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
     tablePrefixBytes = tableDataPtr->prefixBytes;
-    tableFromUnicode = (const unsigned short *const *)
-	    tableDataPtr->fromUnicode;
+    tableFromUnicode = tableDataPtr->fromUnicode;
 
     for (numChars = 0; src < srcEnd; numChars++) {
-	unsigned len;
+	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
@@ -3280,13 +2871,13 @@ EscapeFromUtfProc(
 
 	if ((word == 0) && (ch != 0)) {
 	    int oldState;
-	    const EscapeSubTable *subTablePtr;
-
+	    EscapeSubTable *subTablePtr;
+	    
 	    oldState = state;
 	    for (state = 0; state < dataPtr->numSubTables; state++) {
 		encodingPtr = GetTableEncoding(dataPtr, state);
-		tableDataPtr = encodingPtr->clientData;
-		word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
+		tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
+	    	word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
 		if (word != 0) {
 		    break;
 		}
@@ -3299,20 +2890,18 @@ EscapeFromUtfProc(
 		    break;
 		}
 		encodingPtr = GetTableEncoding(dataPtr, state);
-		tableDataPtr = encodingPtr->clientData;
+		tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
 		word = tableDataPtr->fallback;
-	    }
-
-	    tablePrefixBytes = (const char *) tableDataPtr->prefixBytes;
-	    tableFromUnicode = (const unsigned short *const *)
-		    tableDataPtr->fromUnicode;
+	    } 
+	    
+	    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) {
@@ -3322,12 +2911,11 @@ EscapeFromUtfProc(
 		     * variable because this escape sequence must be written
 		     * in the next conversion.
 		     */
-
 		    state = oldState;
 		    result = TCL_CONVERT_NOSPACE;
 		    break;
 		}
-		memcpy(dst, subTablePtr->sequence,
+		memcpy((VOID *) dst, (VOID *) subTablePtr->sequence,
 			(size_t) subTablePtr->sequenceLen);
 		dst += subTablePtr->sequenceLen;
 	    }
@@ -3348,36 +2936,39 @@ EscapeFromUtfProc(
 	    }
 	    dst[0] = (char) word;
 	    dst++;
-	}
+	} 
 	src += len;
     }
 
     if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
-	unsigned len = dataPtr->subTables[0].sequenceLen;
-
+	unsigned int len = dataPtr->subTables[0].sequenceLen;
 	/*
-	 * Certain encodings like iso2022-jp need to write an escape sequence
-	 * after all characters have been converted. This logic checks that
-	 * enough room is available in the buffer for the escape bytes. The
-	 * TCL_ENCODING_END flag is cleared after a final escape sequence has
-	 * been added to the buffer so that another call to this method does
-	 * not attempt to append escape bytes a second time.
+	 * [Bug 1516109].
+	 * Certain encodings like iso2022-jp need to write
+	 * an escape sequence after all characters have
+	 * been converted. This logic checks that enough
+	 * room is available in the buffer for the escape bytes.
+	 * The TCL_ENCODING_END flag is cleared after a final
+	 * escape sequence has been added to the buffer so
+	 * that another call to this method does not attempt
+	 * to append escape bytes a second time.
 	 */
-
 	if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) {
 	    result = TCL_CONVERT_NOSPACE;
 	} else {
 	    if (state) {
-		memcpy(dst, dataPtr->subTables[0].sequence, len);
+		memcpy((VOID *) dst, (VOID *) dataPtr->subTables[0].sequence,
+			(size_t) len);
 		dst += len;
 	    }
-	    memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen);
+	    memcpy((VOID *) dst, (VOID *) dataPtr->final,
+		    (size_t) dataPtr->finalLen);
 	    dst += dataPtr->finalLen;
 	    state &= ~TCL_ENCODING_END;
 	}
     }
 
-    *statePtr = (Tcl_EncodingState) INT2PTR(state);
+    *statePtr = (Tcl_EncodingState) state;
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -3389,8 +2980,8 @@ EscapeFromUtfProc(
  *
  * EscapeFreeProc --
  *
- *	This function is invoked when an EscapeEncodingData encoding is
- *	deleted. It deletes the memory used by the encoding.
+ *	This procedure is invoked when an EscapeEncodingData encoding is 
+ *	deleted.  It deletes the memory used by the encoding.
  *
  * Results:
  *	None.
@@ -3402,37 +2993,36 @@ EscapeFromUtfProc(
  */
 
 static void
-EscapeFreeProc(
-    ClientData clientData)	/* EscapeEncodingData that specifies
-				 * encoding. */
+EscapeFreeProc(clientData)
+    ClientData clientData;	/* EscapeEncodingData that specifies encoding. */
 {
-    EscapeEncodingData *dataPtr = clientData;
+    EscapeEncodingData *dataPtr;
     EscapeSubTable *subTablePtr;
     int i;
 
+    dataPtr = (EscapeEncodingData *) clientData;
     if (dataPtr == NULL) {
 	return;
     }
-
     /*
-     * The subTables should be freed recursively in normal operation but not
-     * during TclFinalizeEncodingSubsystem because they are also present as a
-     * weak reference in the toplevel encodingTable (i.e., they don't have a
-     * +1 refcount for this), and unpredictable nuking order could remove them
-     * from under the following loop's feet. [Bug 2891556]
-     *
-     * The encodingsInitialized flag, being reset on entry to TFES, can serve
-     * as a "not in finalization" test.
+     *  The subTables should be freed recursively in normal operation but not
+     *  during TclFinalizeEncodingSubsystem because they are also present as a
+     *  weak reference in the toplevel encodingTable (ie they don't have a +1
+     *  refcount for this), and unpredictable nuking order could remove them
+     *  from under the following loop's feet [Bug 2891556].
+     *  
+     *  The encodingsInitialized flag, being reset on entry to TFES, can serve
+     *  as a "not in finalization" test.
      */
-
-    if (encodingsInitialized) {
-	subTablePtr = dataPtr->subTables;
-	for (i = 0; i < dataPtr->numSubTables; i++) {
-	    FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
-	    subTablePtr++;
+    if (encodingsInitialized)
+	{
+	    subTablePtr = dataPtr->subTables;
+	    for (i = 0; i < dataPtr->numSubTables; i++) {
+		FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
+		subTablePtr++;
+	    }
 	}
-    }
-    ckfree(dataPtr);
+    ckfree((char *) dataPtr);
 }
 
 /*
@@ -3440,7 +3030,7 @@ EscapeFreeProc(
  *
  * 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.
  *
@@ -3448,31 +3038,36 @@ EscapeFreeProc(
  *	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(
-    EscapeEncodingData *dataPtr,/* Contains names of encodings. */
-    int state)			/* Index in dataPtr of desired Encoding. */
+GetTableEncoding(dataPtr, state)
+    EscapeEncodingData *dataPtr;/* Contains names of encodings. */
+    int state;			/* Index in dataPtr of desired Encoding. */
 {
-    EscapeSubTable *subTablePtr = &dataPtr->subTables[state];
-    Encoding *encodingPtr = subTablePtr->encodingPtr;
-
+    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
-		&& encodingPtr->toUtfProc != Iso88591ToUtfProc)) {
-	    Tcl_Panic("EscapeToUtfProc: invalid sub table");
+	if ((encodingPtr == NULL) 
+		|| (encodingPtr->toUtfProc != TableToUtfProc)) {
+	    panic("EscapeToUtfProc: invalid sub table");
 	}
 	subTablePtr->encodingPtr = encodingPtr;
     }
-
     return encodingPtr;
 }
 
@@ -3481,9 +3076,9 @@ GetTableEncoding(
  *
  * 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.
@@ -3495,8 +3090,8 @@ GetTableEncoding(
  */
 
 static size_t
-unilen(
-    const char *src)
+unilen(src)
+    CONST char *src;
 {
     unsigned short *p;
 
@@ -3510,75 +3105,83 @@ unilen(
 /*
  *-------------------------------------------------------------------------
  *
- * InitializeEncodingSearchPath	--
+ * TclFindEncodings --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	None.
+ *	Return result of TclpInitLibraryPath, which reports whether the
+ *	path is clean (0) or dirty (1) UTF.
  *
  * Side effects:
- *	Sets the encoding search path to an initial value.
+ *	Varied, see the respective initialization routines.
  *
  *-------------------------------------------------------------------------
  */
 
-static void
-InitializeEncodingSearchPath(
-    char **valuePtr,
-    int *lengthPtr,
-    Tcl_Encoding *encodingPtr)
+static int
+TclFindEncodings(argv0)
+    CONST char *argv0;		/* Name of executable from argv[0] to main()
+				 * in native multi-byte encoding. */
 {
-    const char *bytes;
-    int i, numDirs, numBytes;
-    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
-
-    TclNewLiteralStringObj(encodingObj, "encoding");
-    TclNewObj(searchPathObj);
-    Tcl_IncrRefCount(encodingObj);
-    Tcl_IncrRefCount(searchPathObj);
-    libPathObj = TclGetLibraryPath();
-    Tcl_IncrRefCount(libPathObj);
-    Tcl_ListObjLength(NULL, libPathObj, &numDirs);
-
-    for (i = 0; i < numDirs; i++) {
-	Tcl_Obj *directoryObj, *pathObj;
-	Tcl_StatBuf stat;
-
-	Tcl_ListObjIndex(NULL, libPathObj, i, &directoryObj);
-	pathObj = Tcl_FSJoinToPath(directoryObj, 1, &encodingObj);
-	Tcl_IncrRefCount(pathObj);
-	if ((0 == Tcl_FSStat(pathObj, &stat)) && S_ISDIR(stat.st_mode)) {
-	    Tcl_ListObjAppendElement(NULL, searchPathObj, pathObj);
-	}
-	Tcl_DecrRefCount(pathObj);
-    }
+    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.
+	 */
 
-    Tcl_DecrRefCount(libPathObj);
-    Tcl_DecrRefCount(encodingObj);
-    *encodingPtr = libraryPath.encoding;
-    if (*encodingPtr) {
-	((Encoding *)(*encodingPtr))->refCount++;
+	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);
+	    }
+	}
+	TclpInitUnlock();
     }
-    bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);
 
-    *lengthPtr = numBytes;
-    *valuePtr = ckalloc(numBytes + 1);
-    memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
-    Tcl_DecrRefCount(searchPathObj);
+    return mustCleanUtf;
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
deleted file mode 100644
index 1e1a901..0000000
--- a/generic/tclEnsemble.c
+++ /dev/null
@@ -1,2966 +0,0 @@
-/*
- * tclEnsemble.c --
- *
- *	Contains support for ensembles (see TIP#112), which provide simple
- *	mechanism for creating composite commands on top of namespaces.
- *
- * Copyright (c) 2005-2010 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 "tclCompile.h"
-
-/*
- * Declarations for functions local to this file:
- */
-
-static inline int	EnsembleUnknownCallback(Tcl_Interp *interp,
-			    EnsembleConfig *ensemblePtr, int objc,
-			    Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
-static int		NsEnsembleImplementationCmd(ClientData clientData,
-			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
-static int		NsEnsembleImplementationCmdNR(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);
-
-/*
- * The lists of subcommands and options for the [namespace ensemble] command.
- */
-
-static const char *const ensembleSubcommands[] = {
-    "configure", "create", "exists", NULL
-};
-enum EnsSubcmds {
-    ENS_CONFIG, ENS_CREATE, ENS_EXISTS
-};
-
-static const char *const ensembleCreateOptions[] = {
-    "-command", "-map", "-parameters", "-prefixes", "-subcommands",
-    "-unknown", NULL
-};
-enum EnsCreateOpts {
-    CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
-};
-
-static const char *const ensembleConfigOptions[] = {
-    "-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
-    "-unknown", NULL
-};
-enum EnsConfigOpts {
-    CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS,
-    CONF_UNKNOWN
-};
-
-/*
- * 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.
- */
-
-const Tcl_ObjType tclEnsembleCmdType = {
-    "ensembleCommand",		/* the type's name */
-    FreeEnsembleCmdRep,		/* freeIntRepProc */
-    DupEnsembleCmdRep,		/* dupIntRepProc */
-    StringOfEnsembleCmdRep,	/* updateStringProc */
-    NULL			/* setFromAnyProc */
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * TclNamespaceEnsembleCmd --
- *
- *	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.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclNamespaceEnsembleCmd(
-    ClientData dummy,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Namespace *namespacePtr;
-    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    Tcl_Command token;
-    Tcl_DictSearch search;
-    Tcl_Obj *listObj;
-    int index, done;
-
-    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 < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands,
-	    "subcommand", 0, &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum EnsSubcmds) index) {
-    case ENS_CREATE: {
-	const char *name;
-	int len, allocatedMapFlag = 0;
-	/*
-	 * Defaults
-	 */
-	Tcl_Obj *subcmdObj = NULL;
-	Tcl_Obj *mapObj = NULL;
-	int permitPrefix = 1;
-	Tcl_Obj *unknownObj = NULL;
-	Tcl_Obj *paramObj = NULL;
-
-	/*
-	 * Check that we've got option-value pairs... [Bug 1558654]
-	 */
-
-	if (objc & 1) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
-	    return TCL_ERROR;
-	}
-	objv += 2;
-	objc -= 2;
-
-	/*
-	 * 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], ensembleCreateOptions,
-		    "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_PARAM:
-		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		paramObj = (len > 0 ? objv[1] : NULL);
-		continue;
-	    case CRT_MAP: {
-		Tcl_Obj *patchedDict = NULL, *subcmdWordsObj;
-
-		/*
-		 * Verify that the map is sensible.
-		 */
-
-		if (Tcl_DictObjFirst(interp, objv[1], &search,
-			&subcmdWordsObj, &listObj, &done) != TCL_OK) {
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		if (done) {
-		    mapObj = NULL;
-		    continue;
-		}
-		do {
-		    Tcl_Obj **listv;
-		    const 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, subcmdWordsObj,
-				newList);
-		    }
-		    Tcl_DictObjNext(&search, &subcmdWordsObj,&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);
-	Tcl_SetEnsembleParameterList(interp, token, paramObj);
-
-	/*
-	 * 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 != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "cmdname");
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-		Tcl_FindEnsemble(interp, objv[2], 0) != NULL));
-	return TCL_OK;
-
-    case ENS_CONFIG:
-	if (objc < 3 || (objc != 4 && !(objc & 1))) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "cmdname ?-option value ...? ?arg ...?");
-	    return TCL_ERROR;
-	}
-	token = Tcl_FindEnsemble(interp, objv[2], TCL_LEAVE_ERR_MSG);
-	if (token == NULL) {
-	    return TCL_ERROR;
-	}
-
-	if (objc == 4) {
-	    Tcl_Obj *resultObj = NULL;		/* silence gcc 4 warning */
-
-	    if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions,
-		    "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_PARAM:
-		Tcl_GetEnsembleParameterList(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:
-		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;
-	    }
-	} else if (objc == 3) {
-	    /*
-	     * Produce list of all information.
-	     */
-
-	    Tcl_Obj *resultObj, *tmpObj = NULL;	/* silence gcc 4 warning */
-	    int flags = 0;			/* silence gcc 4 warning */
-
-	    TclNewObj(resultObj);
-
-	    /* -map option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(ensembleConfigOptions[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(ensembleConfigOptions[CONF_NAMESPACE],
-			    -1));
-	    namespacePtr = NULL;		/* silence gcc 4 warning */
-	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(((Namespace *) namespacePtr)->fullName,
-			    -1));
-
-	    /* -parameters option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1));
-	    Tcl_GetEnsembleParameterList(NULL, token, &tmpObj);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
-
-	    /* -prefix option */
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(ensembleConfigOptions[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(ensembleConfigOptions[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(ensembleConfigOptions[CONF_UNKNOWN],-1));
-	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());
-
-	    Tcl_SetObjResult(interp, resultObj);
-	} else {
-	    int len, allocatedMapFlag = 0;
-	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = 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_GetEnsembleParameterList(NULL, token, &paramObj);
-	    Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
-	    Tcl_GetEnsembleFlags(NULL, token, &flags);
-	    permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;
-
-	    objv += 3;
-	    objc -= 3;
-
-	    /*
-	     * 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],ensembleConfigOptions,
-			"option", 0, &index) != TCL_OK) {
-		freeMapAndError:
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    return TCL_ERROR;
-		}
-		switch ((enum EnsConfigOpts) index) {
-		case CONF_SUBCMDS:
-		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			goto freeMapAndError;
-		    }
-		    subcmdObj = (len > 0 ? objv[1] : NULL);
-		    continue;
-		case CONF_PARAM:
-		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			goto freeMapAndError;
-		    }
-		    paramObj = (len > 0 ? objv[1] : NULL);
-		    continue;
-		case CONF_MAP: {
-		    Tcl_Obj *patchedDict = NULL, *subcmdWordsObj, **listv;
-		    const char *cmd;
-
-		    /*
-		     * Verify that the map is sensible.
-		     */
-
-		    if (Tcl_DictObjFirst(interp, objv[1], &search,
-			    &subcmdWordsObj, &listObj, &done) != TCL_OK) {
-			goto freeMapAndError;
-		    }
-		    if (done) {
-			mapObj = NULL;
-			continue;
-		    }
-		    do {
-			if (TclListObjGetElements(interp, listObj, &len,
-				&listv) != TCL_OK) {
-			    Tcl_DictObjDone(&search);
-			    if (patchedDict) {
-				Tcl_DecrRefCount(patchedDict);
-			    }
-			    goto freeMapAndError;
-			}
-			if (len < 1) {
-			    Tcl_SetResult(interp,
-				    "ensemble subcommand implementations "
-				    "must be non-empty lists", TCL_STATIC);
-			    Tcl_DictObjDone(&search);
-			    if (patchedDict) {
-				Tcl_DecrRefCount(patchedDict);
-			    }
-			    goto freeMapAndError;
-			}
-			cmd = TclGetString(listv[0]);
-			if (!(cmd[0] == ':' && cmd[1] == ':')) {
-			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
-			    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, subcmdWordsObj,
-				    newList);
-			}
-			Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
-				&done);
-		    } while (!done);
-		    if (allocatedMapFlag) {
-			Tcl_DecrRefCount(mapObj);
-		    }
-		    mapObj = (patchedDict ? patchedDict : objv[1]);
-		    if (patchedDict) {
-			allocatedMapFlag = 1;
-		    }
-		    continue;
-		}
-		case CONF_NAMESPACE:
-		    Tcl_AppendResult(interp, "option -namespace is read-only",
-			    NULL);
-		    goto freeMapAndError;
-		case CONF_PREFIX:
-		    if (Tcl_GetBooleanFromObj(interp, objv[1],
-			    &permitPrefix) != TCL_OK) {
-			goto freeMapAndError;
-		    }
-		    continue;
-		case CONF_UNKNOWN:
-		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
-			goto freeMapAndError;
-		    }
-		    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_SetEnsembleParameterList(interp, token, paramObj);
-	    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 = ckalloc(sizeof(EnsembleConfig));
-    Tcl_Obj *nameObj = NULL;
-
-    if (nsPtr == NULL) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    }
-
-    /*
-     * Make the name of the ensemble into a fully qualified name. This might
-     * allocate a temporary object.
-     */
-
-    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->numParameters = 0;
-    ensemblePtr->parameterList = NULL;
-    ensemblePtr->unknownHandler = NULL;
-    ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
-	    NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
-	    ensemblePtr, DeleteEnsembleConfig);
-    ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
-    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
-
-    /*
-     * 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!
-     */
-
-    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++;
-
-    /*
-     * 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_SetEnsembleParameterList --
- *
- *	Set the parameter list for a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an ensemble
- *	or the parameter list - if non-NULL - is not a list).
- *
- * Side effects:
- *	The ensemble is updated and marked for recompilation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_SetEnsembleParameterList(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    Tcl_Obj *paramList)
-{
-    Command *cmdPtr = (Command *) token;
-    EnsembleConfig *ensemblePtr;
-    Tcl_Obj *oldList;
-    int length;
-
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
-	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
-	return TCL_ERROR;
-    }
-    if (paramList == NULL) {
-	length = 0;
-    } else {
-	if (TclListObjLength(interp, paramList, &length) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (length < 1) {
-	    paramList = NULL;
-	}
-    }
-
-    ensemblePtr = cmdPtr->objClientData;
-    oldList = ensemblePtr->parameterList;
-    ensemblePtr->parameterList = paramList;
-    if (paramList != NULL) {
-	Tcl_IncrRefCount(paramList);
-    }
-    if (oldList != NULL) {
-	TclDecrRefCount(oldList);
-    }
-    ensemblePtr->numParameters = length;
-
-    /*
-     * 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_SetEnsembleMappingDict --
- *
- *	Set the mapping dictionary for a particular ensemble.
- *
- * Results:
- *	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 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 *cmdObjPtr;
-	    const char *bytes;
-
-	    if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdObjPtr) != TCL_OK) {
-		Tcl_DictObjDone(&search);
-		return TCL_ERROR;
-	    }
-	    bytes = TclGetString(cmdObjPtr);
-	    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 ENSEMBLE_DEAD flag...
-     */
-
-    ensemblePtr->flags &= ENSEMBLE_DEAD;
-    ensemblePtr->flags |= flags & ~ENSEMBLE_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_GetEnsembleParameterList --
- *
- *	Get the list of parameters associated with a particular ensemble.
- *
- * Results:
- *	Tcl result code (error if command token does not indicate an
- *	ensemble). The list of parameters is returned by updating the
- *	variable pointed to by the last parameter (NULL if there are
- *	no parameters).
- *
- * Side effects:
- *	None
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetEnsembleParameterList(
-    Tcl_Interp *interp,
-    Tcl_Command token,
-    Tcl_Obj **paramListPtr)
-{
-    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;
-    *paramListPtr = ensemblePtr->parameterList;
-    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.
- *
- *	The 'name' parameter may be a single command name or a list if
- *	creating an ensemble subcommand (see the binary implementation).
- *
- *	Currently, the TCL_ENSEMBLE_PREFIX ensemble flag is only used on
- *	top-level ensemble commands.
- *
- * Results:
- *	Handle for the new ensemble, or NULL on failure.
- *
- * Side effects:
- *	May advance the bytecode compilation epoch.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-TclMakeEnsemble(
-    Tcl_Interp *interp,
-    const char *name,		 /* The ensemble name (as explained above) */
-    const EnsembleImplMap map[]) /* The subcommands to create */
-{
-    Tcl_Command ensemble;
-    Tcl_Namespace *ns;
-    Tcl_DString buf, hiddenBuf;
-    const char **nameParts = NULL;
-    const char *cmdName = NULL;
-    int i, nameCount = 0, ensembleFlags = 0, hiddenLen;
-
-    /*
-     * Construct the path for the ensemble namespace and create it.
-     */
-
-    Tcl_DStringInit(&buf);
-    Tcl_DStringInit(&hiddenBuf);
-    Tcl_DStringAppend(&hiddenBuf, "tcl:", -1);
-    Tcl_DStringAppend(&hiddenBuf, name, -1);
-    Tcl_DStringAppend(&hiddenBuf, ":", -1);
-    hiddenLen = Tcl_DStringLength(&hiddenBuf);
-    if (name[0] == ':' && name[1] == ':') {
-	/*
-	 * An absolute name, so use it directly.
-	 */
-
-	cmdName = name;
-	Tcl_DStringAppend(&buf, name, -1);
-	ensembleFlags = TCL_ENSEMBLE_PREFIX;
-    } else {
-	/*
-	 * Not an absolute name, so do munging of it. Note that this treats a
-	 * multi-word list differently to a single word.
-	 */
-
-	Tcl_DStringAppend(&buf, "::tcl", -1);
-
-	if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
-	    Tcl_Panic("invalid ensemble name '%s'", name);
-	}
-
-	for (i = 0; i < nameCount; ++i) {
-	    Tcl_DStringAppend(&buf, "::", 2);
-	    Tcl_DStringAppend(&buf, nameParts[i], -1);
-	}
-    }
-
-    ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
-	    TCL_CREATE_NS_IF_UNKNOWN);
-    if (!ns) {
-	Tcl_Panic("unable to find or create %s namespace!",
-		Tcl_DStringValue(&buf));
-    }
-
-    /*
-     * Create the named ensemble in the correct namespace
-     */
-
-    if (cmdName == NULL) {
-	if (nameCount == 1) {
-	    ensembleFlags = TCL_ENSEMBLE_PREFIX;
-	    cmdName = Tcl_DStringValue(&buf) + 5;
-	} else {
-	    ns = ns->parentPtr;
-	    cmdName = nameParts[nameCount - 1];
-	}
-    }
-    ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags);
-
-    /*
-     * Create the ensemble mapping dictionary and the ensemble command procs.
-     */
-
-    if (ensemble != NULL) {
-	Tcl_Obj *mapDict, *fromObj, *toObj;
-	Command *cmdPtr;
-
-	Tcl_DStringAppend(&buf, "::", 2);
-	TclNewObj(mapDict);
-	for (i=0 ; map[i].name != NULL ; i++) {
-	    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);
-
-	    if (map[i].proc || map[i].nreProc) {
-		/*
-		 * If the command is unsafe, hide it when we're in a safe
-		 * interpreter. The code to do this is really hokey! It also
-		 * doesn't work properly yet; this function is always
-		 * currently called before the safe-interp flag is set so the
-		 * Tcl_IsSafe check fails.
-		 */
-
-		if (map[i].unsafe && Tcl_IsSafe(interp)) {
-		    cmdPtr = (Command *)
-			    Tcl_NRCreateCommand(interp, "___tmp", map[i].proc,
-			    map[i].nreProc, map[i].clientData, NULL);
-		    Tcl_DStringSetLength(&hiddenBuf, hiddenLen);
-		    if (Tcl_HideCommand(interp, "___tmp",
-			    Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) {
-			Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
-		    }
-		} else {
-		    /*
-		     * Not hidden, so just create it. Yay!
-		     */
-
-		    cmdPtr = (Command *)
-			    Tcl_NRCreateCommand(interp, TclGetString(toObj),
-			    map[i].proc, map[i].nreProc, map[i].clientData,
-			    NULL);
-		}
-		cmdPtr->compileProc = map[i].compileProc;
-		if (map[i].compileProc != NULL) {
-		    ensembleFlags |= ENSEMBLE_COMPILE;
-		}
-	    }
-	}
-	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
-	if (ensembleFlags & ENSEMBLE_COMPILE) {
-	    Tcl_SetEnsembleFlags(interp, ensemble, ensembleFlags);
-	}
-    }
-
-    Tcl_DStringFree(&buf);
-    Tcl_DStringFree(&hiddenBuf);
-    if (nameParts != NULL) {
-	Tcl_Free((char *) nameParts);
-    }
-    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[])
-{
-    return Tcl_NRCallObjProc(interp, NsEnsembleImplementationCmdNR,
-	    clientData, objc, objv);
-}
-
-static int
-NsEnsembleImplementationCmdNR(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    EnsembleConfig *ensemblePtr = clientData;
-				/* The ensemble itself. */
-    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. */
-    int reparseCount = 0;	/* Number of reparses. */
-
-    /*
-     * Must recheck objc, since numParameters might have changed. Cf. test
-     * namespace-53.9.
-     */
-
-  restartEnsembleParse:
-    if (objc < 2 + ensemblePtr->numParameters) {
-	/*
-	 * We don't have a subcommand argument. Make error message.
-	 */
-
-	Tcl_DString buf;	/* Message being built */
-	Tcl_Obj **elemPtrs;	/* Parameter names */
-	int len;		/* Number of parameters to append */
-
-	Tcl_DStringInit(&buf);
-	if (ensemblePtr->parameterList == NULL) {
-	    len = 0;
-	} else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
-		&len, &elemPtrs) != TCL_OK) {
-	    Tcl_Panic("List of ensemble parameters is not a list");
-	}
-	for (; len>0; len--,elemPtrs++) {
-	    Tcl_DStringAppend(&buf, Tcl_GetString(*elemPtrs), -1);
-	    Tcl_DStringAppend(&buf, " ", -1);
-	}
-	Tcl_DStringAppend(&buf, "subcommand ?arg ...?", -1);
-	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
-	Tcl_DStringFree(&buf);
-
-	return TCL_ERROR;
-    }
-
-    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+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){
-	    EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters]
-		    ->internalRep.otherValuePtr;
-
-	    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 if there is no cache in operation.
-     */
-
-    hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
-	    TclGetString(objv[1 + ensemblePtr->numParameters]));
-    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->numParameters],
-		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.
-	 */
-
-	const 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 + ensemblePtr->numParameters]);
-	stringLength = objv[1 + ensemblePtr->numParameters]->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->numParameters],
-		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,
-     *
-     *   ((Q: That's not true if the -map option is used, is it?))
-     *
-     * but we don't do that (the cacheing of the command object used should
-     * help with that.)
-     */
-
-    {
-	Tcl_Obj **prefixObjv;	/* The list of objects to substitute in as the
-				 * target command prefix. */
-	Tcl_Obj *copyPtr;	/* The actual list of words to dispatch to.
-				 * Will be freed by the dispatch engine. */
-	int prefixObjc, copyObjc;
-	Interp *iPtr = (Interp *) interp;
-
-	/*
-	 * 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.
-	 *
-	 * TODO: Use conventional list operations to make this code sane!
-	 */
-
-	TclListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
-
-	copyObjc = objc - 2 + prefixObjc;
-	copyPtr = Tcl_NewListObj(copyObjc, NULL);
-	if (copyObjc > 0) {
-	    register Tcl_Obj **copyObjv;
-				/* Space used to construct the list of
-				 * arguments to pass to the command that
-				 * implements the ensemble subcommand. */
-	    register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
-	    register int i;
-
-	    listRepPtr->elemCount = copyObjc;
-	    copyObjv = &listRepPtr->elements;
-	    memcpy(copyObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
-	    memcpy(copyObjv+prefixObjc, objv+1,
-		    sizeof(Tcl_Obj *) * ensemblePtr->numParameters);
-	    memcpy(copyObjv+prefixObjc+ensemblePtr->numParameters,
-		    objv+ensemblePtr->numParameters+2,
-		    sizeof(Tcl_Obj *) * (objc-ensemblePtr->numParameters-2));
-
-	    for (i=0; i < copyObjc; i++) {
-		Tcl_IncrRefCount(copyObjv[i]);
-	    }
-	}
-	TclDecrRefCount(prefixObj);
-
-	/*
-	 * Record what arguments the script sent in so that things like
-	 * Tcl_WrongNumArgs can give the correct error message. Parameters
-	 * count both as inserted and removed arguments.
-	 */
-
-	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
-	    iPtr->ensembleRewrite.sourceObjs = objv;
-	    iPtr->ensembleRewrite.numRemovedObjs =
-		    2 + ensemblePtr->numParameters;
-	    iPtr->ensembleRewrite.numInsertedObjs =
-		    prefixObjc + ensemblePtr->numParameters;
-	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
-		    NULL);
-	} else {
-	    register int ni = 2 + ensemblePtr->numParameters
-		    - iPtr->ensembleRewrite.numInsertedObjs;
-				/* Position in objv of new front of insertion
-				 * relative to old one. */
-	    if (ni > 0) {
-		iPtr->ensembleRewrite.numRemovedObjs += ni;
-		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
-	    } else {
-		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
-	    }
-	}
-
-	/*
-	 * Hand off to the target command.
-	 */
-
-	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
-	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
-    }
-
-  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) {
-	switch (EnsembleUnknownCallback(interp, ensemblePtr, objc, objv,
-		&prefixObj)) {
-	case TCL_OK:
-	    goto runResultingSubcommand;
-	case TCL_ERROR:
-	    return TCL_ERROR;
-	case TCL_CONTINUE:
-	    goto restartEnsembleParse;
-	}
-    }
-
-    /*
-     * 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+ensemblePtr->numParameters]), NULL);
-    if (ensemblePtr->subcommandTable.numEntries == 0) {
-	Tcl_AppendResult(interp, "unknown subcommand \"",
-		TclGetString(objv[1+ensemblePtr->numParameters]),
-		"\": namespace ", ensemblePtr->nsPtr->fullName,
-		" does not export any commands", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
-		TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
-	return TCL_ERROR;
-    }
-    Tcl_AppendResult(interp, "unknown ",
-	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
-	    "subcommand \"", TclGetString(objv[1+ensemblePtr->numParameters]),
-	    "\": 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+ensemblePtr->numParameters]), NULL);
-    return TCL_ERROR;
-}
-
-int
-TclClearRootEnsemble(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    TclResetRewriteEnsemble(interp, 1);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitRewriteEnsemble --
- *
- *	Applies a rewrite of arguments so that an ensemble subcommand will
- *	report error messages correctly for the overall command.
- *
- * Results:
- *	Whether this is the first rewrite applied, a value which must be
- *	passed to TclResetRewriteEnsemble when undoing this command's
- *	behaviour.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclInitRewriteEnsemble(
-    Tcl_Interp *interp,
-    int numRemoved,
-    int numInserted,
-    Tcl_Obj *const *objv)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = objv;
-	iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
-	iPtr->ensembleRewrite.numInsertedObjs = numInserted;
-    } else {
-	int numIns = iPtr->ensembleRewrite.numInsertedObjs;
-
-	if (numIns < numRemoved) {
-	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
-	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1;
-	} else {
-	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
-	}
-    }
-    return isRootEnsemble;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclResetRewriteEnsemble --
- *
- *	Removes any rewrites applied to support proper reporting of error
- *	messages used in ensembles. Should be paired with
- *	TclInitRewriteEnsemble.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclResetRewriteEnsemble(
-    Tcl_Interp *interp,
-    int isRootEnsemble)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = NULL;
-	iPtr->ensembleRewrite.numRemovedObjs = 0;
-	iPtr->ensembleRewrite.numInsertedObjs = 0;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * EnsmebleUnknownCallback --
- *
- *	Helper for the ensemble engine that handles the procesing of unknown
- *	callbacks. See the user documentation of the ensemble unknown handler
- *	for details; this function is only ever called when such a function is
- *	defined, and is only ever called once per ensemble dispatch (i.e. if a
- *	reparse still fails, this isn't called again).
- *
- * Results:
- *	TCL_OK -	*prefixObjPtr contains the command words to dispatch
- *			to.
- *	TCL_CONTINUE -	Need to reparse (*prefixObjPtr is invalid).
- *	TCL_ERROR -	Something went wrong! Error message in interpreter.
- *
- * Side effects:
- *	Calls the Tcl interpreter, so arbitrary.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline int
-EnsembleUnknownCallback(
-    Tcl_Interp *interp,
-    EnsembleConfig *ensemblePtr,
-    int objc,
-    Tcl_Obj *const objv[],
-    Tcl_Obj **prefixObjPtr)
-{
-    int paramc, i, result, prefixObjc;
-    Tcl_Obj **paramv, *unknownCmd, *ensObj;
-    char buf[TCL_INTEGER_SPACE];
-
-    /*
-     * Create the unknown command callback to determine what to do.
-     */
-
-    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_IncrRefCount(unknownCmd);
-
-    /*
-     * Now call the unknown handler. (We don't bother NRE-enabling this; deep
-     * recursing through unknown handlers is horribly perverse.) Note that it
-     * is always an error for an unknown handler to delete its ensemble; don't
-     * do that!
-     */
-
-    Tcl_Preserve(ensemblePtr);
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
-    result = Tcl_EvalObjv(interp, paramc, paramv, 0);
-    if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
-	Tcl_SetResult(interp,
-		"unknown subcommand handler deleted its ensemble",
-		TCL_STATIC);
-	result = TCL_ERROR;
-    }
-    Tcl_Release(ensemblePtr);
-
-    /*
-     * If we succeeded, we should either have a list of words that form the
-     * command to be executed, or an empty list. In the empty-list case, the
-     * ensemble is believed to be updated so we should ask the ensemble engine
-     * to reparse the original command.
-     */
-
-    if (result == TCL_OK) {
-	*prefixObjPtr = Tcl_GetObjResult(interp);
-	Tcl_IncrRefCount(*prefixObjPtr);
-	TclDecrRefCount(unknownCmd);
-	Tcl_ResetResult(interp);
-
-	/*
-	 * 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, *prefixObjPtr, &prefixObjc) != TCL_OK) {
-	    TclDecrRefCount(*prefixObjPtr);
-	    Tcl_AddErrorInfo(interp, "\n    while parsing result of "
-		    "ensemble unknown subcommand handler");
-	    return TCL_ERROR;
-	}
-	if (prefixObjc > 0) {
-	    return TCL_OK;
-	}
-
-	/*
-	 * Namespace alive & empty result => reparse.
-	 */
-
-	TclDecrRefCount(*prefixObjPtr);
-	return TCL_CONTINUE;
-    }
-
-    /*
-     * Oh no! An exceptional result. Convert to an error.
-     */
-
-    if (!Tcl_InterpDeleted(interp)) {
-	if (result != TCL_ERROR) {
-	    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)");
-	}
-    }
-    TclDecrRefCount(unknownCmd);
-    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
-MakeCachedEnsembleCommand(
-    Tcl_Obj *objPtr,
-    EnsembleConfig *ensemblePtr,
-    const char *subcommandName,
-    Tcl_Obj *prefixObjPtr)
-{
-    register EnsembleCmdRep *ensembleCmd;
-    int length;
-
-    if (objPtr->typePtr == &tclEnsembleCmdType) {
-	ensembleCmd = objPtr->internalRep.otherValuePtr;
-	Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
-	TclNsDecrRefCount(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 = ckalloc(sizeof(EnsembleCmdRep));
-	objPtr->internalRep.otherValuePtr = 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(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;
-	    }
-	}
-    }
-
-    /*
-     * Mark the namespace as dead so code that uses Tcl_Preserve() can tell
-     * whether disaster happened anyway.
-     */
-
-    ensemblePtr->flags |= ENSEMBLE_DEAD;
-
-    /*
-     * Kill the pointer-containing fields.
-     */
-
-    if (ensemblePtr->subcommandTable.numEntries != 0) {
-	ckfree(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->parameterList != NULL) {
-	Tcl_DecrRefCount(ensemblePtr->parameterList);
-    }
-    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.
-	 */
-
-	ckfree(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++) {
-	    const 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) {
-	    const char *name = TclGetString(keyObj);
-
-	    hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
-	    Tcl_SetHashValue(hPtr, valueObj);
-	    Tcl_IncrRefCount(valueObj);
-	    Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
-	}
-    } else {
-	/*
-	 * 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 =
-	    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.otherValuePtr;
-
-    Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
-    ckfree(ensembleCmd->fullSubcmdName);
-    TclNsDecrRefCount(ensembleCmd->nsPtr);
-    ckfree(ensembleCmd);
-    objPtr->typePtr = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.otherValuePtr;
-    EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
-    int length = strlen(ensembleCmd->fullSubcmdName);
-
-    copyPtr->typePtr = &tclEnsembleCmdType;
-    copyPtr->internalRep.otherValuePtr = 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(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.otherValuePtr;
-    int length = strlen(ensembleCmd->fullSubcmdName);
-
-    objPtr->length = length;
-    objPtr->bytes = ckalloc(length + 1);
-    memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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, result, flags = 0, i;
-    unsigned numBytes;
-    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;
-    }
-
-    /*
-     * Also refuse to compile anything that uses a formal parameter list for
-     * now, on the grounds that it is too complex.
-     */
-
-    if (Tcl_GetEnsembleParameterList(NULL, ensemble, &listObj) != TCL_OK
-	    || listObj != NULL) {
-	/*
-	 * Figuring out how to compile this has become too much. Bail out.
-	 */
-
-	return TCL_ERROR;
-    }
-
-    /*
-     * Next, get the flags. We need them on several code paths so that we can
-     * know whether we're to do prefix matching.
-     */
-
-    (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 == (int) numBytes) && !memcmp(word, str, 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, numBytes) == 0) {
-		if (matchObj != NULL) {
-		    return TCL_ERROR;
-		}
-		matchObj = elems[i];
-	    }
-	}
-	if (matchObj == NULL) {
-	    return TCL_ERROR;
-	}
-	result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
-	if (result != TCL_OK || targetCmdObj == NULL) {
-	    return TCL_ERROR;
-	}
-    } else {
-	Tcl_DictSearch s;
-	int done, matched;
-	Tcl_Obj *tmpObj;
-
-	/*
-	 * No map, so check the dictionary directly.
-	 */
-
-	TclNewStringObj(subcmdObj, word, (int) 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)) {
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * 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, 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;
-	}
-    }
-
-    /*
-     * 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->nsPtr->flags & NS_SUPPRESS_COMPILATION
-	    || 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;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index e45ae6a..7108436 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -1,79 +1,80 @@
 /*
  * tclEnv.c --
  *
- *	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.
+ *	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.
  *
  * 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 struct {
-    int cacheSize;		/* Number of env strings in cache. */
-    char **cache;		/* Array containing all of the environment
+static int cacheSize = 0;	/* Number of env strings in environCache. */
+static char **environCache = NULL;
+				/* Array containing all of the environment
 				 * strings that Tcl has allocated. */
+
 #ifndef USE_PUTENV
-    char **ourEnviron;		/* Cache of the array that we allocate. We
-				 * need to track this in case another
+static char **ourEnviron = NULL;/* Cache of the array that we allocate.
+				 * We need to track this in case another
 				 * subsystem swaps around the environ array
-				 * like we do. */
-    int ourEnvironSize;		/* Non-zero means that the environ array was
+				 * like we do.
+				 */
+static int environSize = 0;	/* 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 functions defined in this file:
+ * Declarations for local procedures defined in this file:
  */
 
-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
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * TclSetupEnv --
  *
- *	This function is invoked for an interpreter to make environment
- *	variables accessible from that interpreter via the "env" associative
- *	array.
+ *	This procedure 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(
-    Tcl_Interp *interp)		/* Interpreter whose "env" array is to be
+TclSetupEnv(interp)
+    Tcl_Interp *interp;		/* Interpreter whose "env" array is to be
 				 * managed. */
 {
     Tcl_DString envString;
@@ -81,27 +82,28 @@ TclSetupEnv(
     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", NULL,
+    
+    Tcl_UntraceVar2(interp, "env", (char *) NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
-
-    Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
-
+	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
+	    (ClientData) NULL);
+    
+    Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY); 
+    
     if (environ[0] == NULL) {
 	Tcl_Obj *varNamePtr;
-
-	TclNewLiteralStringObj(varNamePtr, "env");
+	
+	varNamePtr = Tcl_NewStringObj("env", -1);
 	Tcl_IncrRefCount(varNamePtr);
-	TclArraySet(interp, varNamePtr, NULL);
+	TclArraySet(interp, varNamePtr, NULL);	
 	Tcl_DecrRefCount(varNamePtr);
     } else {
 	Tcl_MutexLock(&envMutex);
@@ -111,23 +113,23 @@ TclSetupEnv(
 	    if (p2 == NULL) {
 		/*
 		 * This condition seem to happen occasionally under some
-		 * versions of Solaris, or when encoding accidents swallow the
-		 * '='; ignore the entry.
+		 * versions of Solaris; 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", NULL,
+    Tcl_TraceVar2(interp, "env", (char *) NULL,
 	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
-	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
+	    TCL_TRACE_READS | TCL_TRACE_ARRAY,  EnvTraceProc,
+	    (ClientData) NULL);
 }
 
 /*
@@ -135,12 +137,12 @@ TclSetupEnv(
  *
  * 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
- *	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".
+ *	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".
  *
  * Results:
  *	None.
@@ -152,21 +154,20 @@ TclSetupEnv(
  */
 
 void
-TclSetEnv(
-    const char *name,		/* Name of variable whose value is to be set
-				 * (UTF-8). */
-    const char *value)		/* New value for variable (UTF-8). */
+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). */
 {
     Tcl_DString envString;
-    unsigned nameLength, valueLength;
-    int index, length;
+    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);
@@ -176,38 +177,40 @@ TclSetEnv(
 #ifndef USE_PUTENV
 	/*
 	 * We need to handle the case where the environment may be changed
-	 * outside our control. ourEnvironSize is only valid if the current
+	 * outside our control.  environSize is only valid if the current
 	 * environment is the one we allocated. [Bug 979640]
 	 */
-
-	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
-	    char **newEnviron = ckalloc((length + 5) * sizeof(char *));
-
-	    memcpy(newEnviron, environ, length * sizeof(char *));
-	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
-		ckfree(env.ourEnviron);
+	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);
 	    }
-	    environ = env.ourEnviron = newEnviron;
-	    env.ourEnvironSize = length + 5;
+	    environ = ourEnviron = newEnviron;
+	    environSize = length + 5;
 	}
 	index = length;
 	environ[index + 1] = NULL;
-#endif /* USE_PUTENV */
+#endif
 	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;
@@ -215,28 +218,27 @@ TclSetEnv(
 	Tcl_DStringFree(&envString);
 
 	oldValue = environ[index];
-	nameLength = (unsigned) length;
+	nameLength = length;
     }
 
     /*
-     * 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.
      */
 
-    valueLength = strlen(value);
-    p = ckalloc(nameLength + valueLength + 2);
-    memcpy(p, name, nameLength);
+    p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
+    strcpy(p, name);
     p[nameLength] = '=';
-    memcpy(p+nameLength+1, value, valueLength+1);
+    strcpy(p+nameLength+1, value);
     p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);
 
     /*
      * Copy the native string to heap memory.
      */
-
-    p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
-    memcpy(p, p2, (unsigned) Tcl_DStringLength(&envString) + 1);
+    
+    p = (char *) ckrealloc(p, (unsigned) (strlen(p2) + 1));
+    strcpy(p, p2);
     Tcl_DStringFree(&envString);
 
 #ifdef USE_PUTENV
@@ -248,35 +250,32 @@ TclSetEnv(
     index = TclpFindVariable(name, &length);
 #else
     environ[index] = p;
-#endif /* USE_PUTENV */
+#endif
 
     /*
-     * 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 /* HAVE_PUTENV_THAT_COPIES */
+#endif
     }
 
     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);
     }
 }
 
@@ -285,42 +284,44 @@ TclSetEnv(
  *
  * 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 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".
+ *	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".
  *
  * 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(
-    const char *assignment)	/* Info about environment variable in the form
-				 * NAME=value. (native) */
+Tcl_PutEnv(string)
+    CONST char *string;		/* 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 (assignment == NULL) {
+    if (string == 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, assignment, -1, &nameString);
+    name = Tcl_ExternalToUtfDString(NULL, string, -1, &nameString);
     value = strchr(name, '=');
 
     if ((value != NULL) && (value != name)) {
@@ -337,10 +338,11 @@ Tcl_PutEnv(
  *
  * 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.
@@ -352,8 +354,8 @@ Tcl_PutEnv(
  */
 
 void
-TclUnsetEnv(
-    const char *name)		/* Name of variable to remove (UTF-8). */
+TclUnsetEnv(name)
+    CONST char *name;		/* Name of variable to remove (UTF-8). */
 {
     char *oldValue;
     int length;
@@ -363,21 +365,20 @@ TclUnsetEnv(
     char *string;
 #else
     char **envPtr;
-#endif /* USE_PUTENV_FOR_UNSET */
+#endif
 
     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.
      */
@@ -385,8 +386,8 @@ TclUnsetEnv(
     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
@@ -394,44 +395,39 @@ TclUnsetEnv(
      * For those platforms that support putenv to unset, Linux indicates
      * that no = should be included, and Windows requires it.
      */
-
-#if defined(__WIN32__) || defined(__CYGWIN__)
-    string = ckalloc(length + 2);
-    memcpy(string, name, (size_t) length);
+#ifdef WIN32
+    string = ckalloc((unsigned int) length+2);
+    memcpy((VOID *) string, (VOID *) name, (size_t) length);
     string[length] = '=';
     string[length+1] = '\0';
 #else
-    string = ckalloc(length + 1);
-    memcpy(string, name, (size_t) length);
+    string = ckalloc((unsigned int) length+1);
+    memcpy((VOID *) string, (VOID *) name, (size_t) length);
     string[length] = '\0';
-#endif /* WIN32 */
+#endif
 
     Tcl_UtfToExternalDString(NULL, string, -1, &envString);
-    string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
-    memcpy(string, Tcl_DStringValue(&envString),
-	    (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 /* HAVE_PUTENV_THAT_COPIES */
+#endif
     }
-#else /* !USE_PUTENV_FOR_UNSET */
+#else
     for (envPtr = environ+index+1; ; envPtr++) {
 	envPtr[-1] = *envPtr;
 	if (*envPtr == NULL) {
@@ -439,7 +435,7 @@ TclUnsetEnv(
 	}
     }
     ReplaceString(oldValue, NULL);
-#endif /* USE_PUTENV_FOR_UNSET */
+#endif
 
     Tcl_MutexUnlock(&envMutex);
 }
@@ -453,10 +449,10 @@ TclUnsetEnv(
  *
  * 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.
@@ -464,23 +460,23 @@ TclUnsetEnv(
  *----------------------------------------------------------------------
  */
 
-const char *
-TclGetEnv(
-    const char *name,		/* Name of environment variable to find
+CONST char *
+TclGetEnv(name, valuePtr)
+    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 == '=') {
@@ -502,31 +498,32 @@ TclGetEnv(
  *
  * EnvTraceProc --
  *
- *	This function is invoked whenever an environment variable is read,
- *	modified or deleted. It propagates the change to the global "environ"
- *	array.
+ *	This procedure 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 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, 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. */
 {
     /*
      * For array traces, let TclSetupEnv do all the work.
@@ -540,7 +537,7 @@ EnvTraceProc(
     /*
      * If name2 is NULL, then return and do nothing.
      */
-
+     
     if (name2 == NULL) {
 	return NULL;
     }
@@ -550,8 +547,8 @@ EnvTraceProc(
      */
 
     if (flags & TCL_TRACE_WRITES) {
-	const char *value;
-
+	CONST char *value;
+	
 	value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
 	TclSetEnv(name2, value);
     }
@@ -562,10 +559,11 @@ EnvTraceProc(
 
     if (flags & TCL_TRACE_READS) {
 	Tcl_DString valueString;
-	const char *value = TclGetEnv(name2, &valueString);
+	CONST char *value;
 
+	value = TclGetEnv(name2, &valueString);
 	if (value == NULL) {
-	    return (char *) "no such variable";
+	    return "no such variable";
 	}
 	Tcl_SetVar2(interp, name1, name2, value, 0);
 	Tcl_DStringFree(&valueString);
@@ -586,9 +584,9 @@ EnvTraceProc(
  *
  * 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.
@@ -600,54 +598,61 @@ EnvTraceProc(
  */
 
 static void
-ReplaceString(
-    const char *oldStr,		/* Old environment string. */
-    char *newStr)		/* New environment string. */
+ReplaceString(oldStr, newStr)
+    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 < env.cacheSize; i++) {
-	if (env.cache[i]==oldStr || env.cache[i]==NULL) {
+    for (i = 0; i < cacheSize; i++) {
+	if ((environCache[i] == oldStr) || (environCache[i] == NULL)) {
 	    break;
 	}
     }
-    if (i < env.cacheSize) {
+    if (i < cacheSize) {
 	/*
 	 * Replace or delete the old value.
 	 */
 
-	if (env.cache[i]) {
-	    ckfree(env.cache[i]);
+	if (environCache[i]) {
+	    ckfree(environCache[i]);
 	}
 
 	if (newStr) {
-	    env.cache[i] = newStr;
+	    environCache[i] = newStr;
 	} else {
-	    for (; i < env.cacheSize-1; i++) {
-		env.cache[i] = env.cache[i+1];
+	    for (; i < cacheSize-1; i++) {
+		environCache[i] = environCache[i+1];
 	    }
-	    env.cache[env.cacheSize-1] = NULL;
+	    environCache[cacheSize-1] = NULL;
 	}
     } else {
+        int allocatedSize = (cacheSize + 5) * sizeof(char *);
+
 	/*
 	 * We need to grow the cache in order to hold the new string.
 	 */
 
-	const int growth = 5;
+	newCache = (char **) ckalloc((unsigned) allocatedSize);
+        (VOID *) memset(newCache, (int) 0, (size_t) allocatedSize);
 
-	env.cache = ckrealloc(env.cache,
-		(env.cacheSize + growth) * sizeof(char *));
-	env.cache[env.cacheSize] = newStr;
-	(void) memset(env.cache+env.cacheSize+1, 0,
-		(size_t) (growth-1) * sizeof(char *));
-	env.cacheSize += growth;
+	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;
     }
 }
 
@@ -656,9 +661,9 @@ ReplaceString(
  *
  * 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.
@@ -670,118 +675,26 @@ ReplaceString(
  */
 
 void
-TclFinalizeEnvironment(void)
+TclFinalizeEnvironment()
 {
     /*
      * 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 (env.cache) {
-	ckfree(env.cache);
-	env.cache = NULL;
-	env.cacheSize = 0;
+    if (environCache) {
+	ckfree((char *) environCache);
+	environCache = NULL;
+	cacheSize    = 0;
 #ifndef USE_PUTENV
-	env.ourEnvironSize = 0;
+	environSize  = 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';
-    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_posix_to_win32_path_list_buf_size(value);
-	    buf = alloca(size + 1);
-	    cygwin_posix_to_win32_path_list(value, buf);
-	}
-
-	SetEnvironmentVariableA(name, buf);
-    }
-}
-#endif /* __CYGWIN__ */
-
 /*
  * Local Variables:
  * mode: c
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index e65862c..06b3a4c 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -1,45 +1,50 @@
-/*
+/* 
  * tclEvent.c --
  *
  *	This file implements some general event related interfaces including
- *	background errors, exit handlers, and the "vwait" and "update" command
- *	functions.
+ *	background errors, exit handlers, and the "vwait" and "update"
+ *	command procedures. 
  *
  * 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 an idle handler command can be invoked.
+ * 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.
  */
 
 typedef struct BgError {
-    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. */
+    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. */
 } 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). */
@@ -49,20 +54,21 @@ typedef struct ErrAssocData {
 } ErrAssocData;
 
 /*
- * For each exit handler created with a call to Tcl_Create(Late)ExitHandler
- * there is a structure of the following type:
+ * For each exit handler created with a call to Tcl_Create(Late)ExitHandler there is
+ * a structure of the following type:
  */
 
 typedef struct ExitHandler {
-    Tcl_ExitProc *proc;		/* Function to call when process exits. */
+    Tcl_ExitProc *proc;		/* Procedure 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;
@@ -74,103 +80,132 @@ static ExitHandler *firstLateExitPtr = NULL;
 TCL_DECLARE_MUTEX(exitMutex)
 
 /*
- * This variable is set to 1 when Tcl_Exit is called. The variable is checked
- * by TclInExit() to allow different behavior for exit-time processing, e.g.,
- * in closing of files and pipes.
+ * 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.
  */
 
-static int inExit = 0;
-
+static int inFinalize = 0;
 static int subsystemsInitialized = 0;
 
-/*
- * 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 Tcl_ExitProc *appExitPtr = NULL;
-
 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. */
+    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.
+ */
+static char *tclLibraryPathStr = NULL;
+
+
 #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(ClientData clientData);
-#endif /* TCL_THREADS */
+static Tcl_ThreadCreateType NewThreadProc _ANSI_ARGS_((
+           ClientData clientData));
+#endif
 
 /*
- * Prototypes for functions referenced only in this file:
+ * Prototypes for procedures referenced only in this file:
  */
 
-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);
-static void		InvokeExitHandlers(void);
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_BackgroundError --
  *
- *	This function is invoked to handle errors that occur in Tcl commands
- *	that are invoked in "background" (e.g. from event or timer bindings).
+ *	This procedure 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:
- *	A handler command is invoked later as an idle handler to process the
- *	error, passing it the interp result and return options.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_BackgroundError(
-    Tcl_Interp *interp)		/* Interpreter in which an error has
+Tcl_BackgroundError(interp)
+    Tcl_Interp *interp;		/* Interpreter in which an error has
 				 * occurred. */
 {
-    Tcl_BackgroundException(interp, TCL_ERROR);
-}
-
-void
-Tcl_BackgroundException(
-    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;
 
-    if (code == TCL_OK) {
-	return;
-    }
+    /*
+     * 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.
+     */
 
-    errPtr = ckalloc(sizeof(BgError));
-    errPtr->errorMsg = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(errPtr->errorMsg);
-    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
-    Tcl_IncrRefCount(errPtr->returnOpts);
+    Tcl_AddErrorInfo(interp, "");
+
+    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->nextPtr = NULL;
 
-    (void) TclGetBgErrorHandler(interp);
-    assocPtr = Tcl_GetAssocData(interp, "tclBgError", 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);
+    }
     if (assocPtr->firstBgPtr == NULL) {
 	assocPtr->firstBgPtr = errPtr;
-	Tcl_DoWhenIdle(HandleBgErrors, assocPtr);
+	Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
     } else {
 	assocPtr->lastBgPtr->nextPtr = errPtr;
     }
@@ -183,392 +218,145 @@ Tcl_BackgroundException(
  *
  * HandleBgErrors --
  *
- *	This function is invoked as an idle handler to process all of the
- *	accumulated background errors.
+ *	This procedure is invoked as an idle handler to process all of
+ *	the accumulated background errors.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Depends on what actions the handler command takes for the errors.
+ *	Depends on what actions "bgerror" takes for the errors.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-HandleBgErrors(
-    ClientData clientData)	/* Pointer to ErrAssocData structure. */
+HandleBgErrors(clientData)
+    ClientData clientData;	/* Pointer to ErrAssocData structure. */
 {
-    ErrAssocData *assocPtr = clientData;
-    Tcl_Interp *interp = assocPtr->interp;
+    Tcl_Interp *interp;
+    CONST char *argv[2];
+    int code;
     BgError *errPtr;
+    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
+    Tcl_Channel errChannel;
 
-    /*
-     * 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(assocPtr);
-    Tcl_Preserve(interp);
+    Tcl_Preserve((ClientData) assocPtr);
+    
     while (assocPtr->firstBgPtr != NULL) {
-	int code, prefixObjc;
-	Tcl_Obj **prefixObjv, **tempObjv;
+	interp = assocPtr->firstBgPtr->interp;
+	if (interp == NULL) {
+	    goto doneWithInterp;
+	}
 
 	/*
-	 * Note we copy the handler command prefix each pass through, so we do
-	 * support one handler setting another handler.
+	 * Restore important state variables to what they were at
+	 * the time the error occurred.
 	 */
 
-	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
-
-	errPtr = assocPtr->firstBgPtr;
-
-	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
-	tempObjv = 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);
+	Tcl_SetVar(interp, "errorInfo", assocPtr->firstBgPtr->errorInfo,
+		TCL_GLOBAL_ONLY);
+	Tcl_SetVar(interp, "errorCode", assocPtr->firstBgPtr->errorCode,
+		TCL_GLOBAL_ONLY);
 
 	/*
-	 * Discard the command and the information about the error report.
+	 * Create and invoke the bgerror command.
 	 */
 
-	Tcl_DecrRefCount(copyObj);
-	Tcl_DecrRefCount(errPtr->errorMsg);
-	Tcl_DecrRefCount(errPtr->returnOpts);
-	assocPtr->firstBgPtr = errPtr->nextPtr;
-	ckfree(errPtr);
-	ckfree(tempObjv);
+	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) {
 
-	if (code == TCL_BREAK) {
 	    /*
 	     * Break means cancel any remaining error reports for this
 	     * interpreter.
 	     */
 
-	    while (assocPtr->firstBgPtr != NULL) {
-		errPtr = assocPtr->firstBgPtr;
-		assocPtr->firstBgPtr = errPtr->nextPtr;
-		Tcl_DecrRefCount(errPtr->errorMsg);
-		Tcl_DecrRefCount(errPtr->returnOpts);
-		ckfree(errPtr);
-	    }
-	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
-	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
-
-	    if (errChannel != 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));
+	    for (errPtr = assocPtr->firstBgPtr; errPtr != NULL;
+		    errPtr = errPtr->nextPtr) {
+		if (errPtr->interp == interp) {
+		    errPtr->interp = NULL;
 		}
-		Tcl_WriteChars(errChannel, "\n", 1);
-		Tcl_Flush(errChannel);
-		Tcl_DecrRefCount(options);
 	    }
 	}
-    }
-    assocPtr->lastBgPtr = NULL;
-    Tcl_Release(interp);
-    Tcl_Release(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));
-	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-	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));
-	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-	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) {
 	/*
-	 * Somehow we got to exception handling with no exception. (Pass
-	 * TCL_OK to Tcl_BackgroundException()?) Just return without doing
-	 * anything.
+	 * Discard the command and the information about the error report.
 	 */
 
-	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]);
-    }
-
-    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);
-    }
+doneWithInterp:
 
-    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 (Tcl_IsSafe(interp)) {
-	    Tcl_RestoreInterpState(interp, saved);
-	    TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN);
-	} else {
-	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
-
-	    if (errChannel != 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 (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;
 	}
-	code = TCL_OK;
-    } else {
-	Tcl_DiscardInterpState(saved);
-    }
-
-    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 = Tcl_GetAssocData(interp, "tclBgError", NULL);
-
-    if (cmdPrefix == NULL) {
-	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
-    }
-    if (assocPtr == NULL) {
-	/*
-	 * First access: initialize.
-	 */
-
-	assocPtr = ckalloc(sizeof(ErrAssocData));
-	assocPtr->interp = interp;
-	assocPtr->cmdPrefix = NULL;
-	assocPtr->firstBgPtr = NULL;
-	assocPtr->lastBgPtr = NULL;
-	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
-    }
-    if (assocPtr->cmdPrefix) {
-	Tcl_DecrRefCount(assocPtr->cmdPrefix);
+        
+        if (interp != NULL) {
+            Tcl_Release((ClientData) interp);
+        }
     }
-    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 = Tcl_GetAssocData(interp, "tclBgError", NULL);
-
-    if (assocPtr == NULL) {
-	Tcl_Obj *bgerrorObj;
+    assocPtr->lastBgPtr = NULL;
 
-	TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
-	TclSetBgErrorHandler(interp, bgerrorObj);
-	assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
-    }
-    return assocPtr->cmdPrefix;
+    Tcl_Release((ClientData) assocPtr);
 }
 
 /*
@@ -576,38 +364,39 @@ TclGetBgErrorHandler(
  *
  * BgErrorDeleteProc --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Background error information is freed: if there were any pending error
- *	reports, they are canceled.
+ *	Background error information is freed: if there were any
+ *	pending error reports, they are cancelled.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-BgErrorDeleteProc(
-    ClientData clientData,	/* Pointer to ErrAssocData structure. */
-    Tcl_Interp *interp)		/* Interpreter being deleted. */
+BgErrorDeleteProc(clientData, interp)
+    ClientData clientData;	/* Pointer to ErrAssocData structure. */
+    Tcl_Interp *interp;		/* Interpreter being deleted. */
 {
-    ErrAssocData *assocPtr = clientData;
+    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
     BgError *errPtr;
 
     while (assocPtr->firstBgPtr != NULL) {
 	errPtr = assocPtr->firstBgPtr;
 	assocPtr->firstBgPtr = errPtr->nextPtr;
-	Tcl_DecrRefCount(errPtr->errorMsg);
-	Tcl_DecrRefCount(errPtr->returnOpts);
-	ckfree(errPtr);
+	ckfree(errPtr->errorMsg);
+	ckfree(errPtr->errorInfo);
+	ckfree(errPtr->errorCode);
+	ckfree((char *) errPtr);
     }
-    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
-    Tcl_DecrRefCount(assocPtr->cmdPrefix);
-    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
+    Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
+    Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
 }
 
 /*
@@ -615,26 +404,27 @@ BgErrorDeleteProc(
  *
  * Tcl_CreateExitHandler --
  *
- *	Arrange for a given function to be invoked just before the application
- *	exits.
+ *	Arrange for a given procedure 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(
-    Tcl_ExitProc *proc,		/* Function to invoke. */
-    ClientData clientData)	/* Arbitrary value to pass to proc. */
+Tcl_CreateExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure to invoke. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
 {
-    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
+    ExitHandler *exitPtr;
 
+    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
     exitPtr->proc = proc;
     exitPtr->clientData = clientData;
     Tcl_MutexLock(&exitMutex);
@@ -648,8 +438,7 @@ Tcl_CreateExitHandler(
  *
  * TclCreateLateExitHandler --
  *
- *	Arrange for a given function to be invoked after all pre-thread
- *	cleanups.
+ *	Arrange for a given function to be invoked after all pre-thread cleanups
  *
  * Results:
  *	None.
@@ -666,8 +455,9 @@ TclCreateLateExitHandler(
     Tcl_ExitProc *proc,		/* Function to invoke. */
     ClientData clientData)	/* Arbitrary value to pass to proc. */
 {
-    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
+    ExitHandler *exitPtr;
 
+    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
     exitPtr->proc = proc;
     exitPtr->clientData = clientData;
     Tcl_MutexLock(&exitMutex);
@@ -681,23 +471,24 @@ TclCreateLateExitHandler(
  *
  * Tcl_DeleteExitHandler --
  *
- *	This function cancels an existing exit handler matching proc and
- *	clientData, if such a handler exits.
+ *	This procedure 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 canceled; 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(
-    Tcl_ExitProc *proc,		/* Function that was previously registered. */
-    ClientData clientData)	/* Arbitrary value to pass to proc. */
+Tcl_DeleteExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
 {
     ExitHandler *exitPtr, *prevPtr;
 
@@ -711,7 +502,7 @@ Tcl_DeleteExitHandler(
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
-	    ckfree(exitPtr);
+	    ckfree((char *) exitPtr);
 	    break;
 	}
     }
@@ -731,8 +522,8 @@ Tcl_DeleteExitHandler(
  *	None.
  *
  * Side effects:
- *	If there is a late exit handler corresponding to proc and clientData
- *	then it is canceled; if no such handler exists then nothing happens.
+ *	If there is a late exit handler corresponding to proc and clientData then
+ *	it is canceled; if no such handler exists then nothing happens.
  *
  *----------------------------------------------------------------------
  */
@@ -754,7 +545,7 @@ TclDeleteLateExitHandler(
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
-	    ckfree(exitPtr);
+	    ckfree((char *) exitPtr);
 	    break;
 	}
     }
@@ -767,28 +558,28 @@ TclDeleteLateExitHandler(
  *
  * Tcl_CreateThreadExitHandler --
  *
- *	Arrange for a given function to be invoked just before the current
- *	thread exits.
+ *	Arrange for a given procedure 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(
-    Tcl_ExitProc *proc,		/* Function to invoke. */
-    ClientData clientData)	/* Arbitrary value to pass to proc. */
+Tcl_CreateThreadExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure to invoke. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
 {
     ExitHandler *exitPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    exitPtr = ckalloc(sizeof(ExitHandler));
+    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
     exitPtr->proc = proc;
     exitPtr->clientData = clientData;
     exitPtr->nextPtr = tsdPtr->firstExitPtr;
@@ -800,23 +591,24 @@ Tcl_CreateThreadExitHandler(
  *
  * Tcl_DeleteThreadExitHandler --
  *
- *	This function cancels an existing exit handler matching proc and
- *	clientData, if such a handler exits.
+ *	This procedure 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 canceled; 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(
-    Tcl_ExitProc *proc,		/* Function that was previously registered. */
-    ClientData clientData)	/* Arbitrary value to pass to proc. */
+Tcl_DeleteThreadExitHandler(proc, clientData)
+    Tcl_ExitProc *proc;		/* Procedure that was previously registered. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
 {
     ExitHandler *exitPtr, *prevPtr;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -830,7 +622,7 @@ Tcl_DeleteThreadExitHandler(
 	    } else {
 		prevPtr->nextPtr = exitPtr->nextPtr;
 	    }
-	    ckfree(exitPtr);
+	    ckfree((char *) exitPtr);
 	    return;
 	}
     }
@@ -839,155 +631,113 @@ Tcl_DeleteThreadExitHandler(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SetExitProc --
+ * Tcl_Exit --
  *
- *	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.
+ *	This procedure is called to terminate the application.
  *
  * Results:
- *	The previously set application wide exit handler.
+ *	None.
  *
  * Side effects:
- *	Sets the application wide exit handler to the specified value.
+ *	All existing exit handlers are invoked, then the application
+ *	ends.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_ExitProc *
-Tcl_SetExitProc(
-    Tcl_ExitProc *proc)		/* New exit handler for app or NULL */
+void
+Tcl_Exit(status)
+    int status;			/* Exit status for application;  typically
+				 * 0 for normal return, 1 for error return. */
 {
-    Tcl_ExitProc *prevExitProc;
-
-    /*
-     * Swap the old exit proc for the new one, saving the old one for our
-     * return value.
-     */
-
-    Tcl_MutexLock(&exitMutex);
-    prevExitProc = appExitPtr;
-    appExitPtr = proc;
-    Tcl_MutexUnlock(&exitMutex);
-
-    return prevExitProc;
+    Tcl_Finalize();
+    TclpExit(status);
 }
-
 
 /*
- *----------------------------------------------------------------------
- *
- * InvokeExitHandlers --
+ *-------------------------------------------------------------------------
+ * 
+ * TclSetLibraryPath --
  *
- *      Call the registered exit handlers.
+ *	Set the path that will be used for searching for init.tcl and 
+ *	encodings when an interp is being created.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The exit handlers are invoked, and the ExitHandler struct is
- *      freed.
+ *	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.
+ *
+ *-------------------------------------------------------------------------
  */
-static void
-InvokeExitHandlers(void) 
-{
-    ExitHandler *exitPtr;
 
-    Tcl_MutexLock(&exitMutex);
-    inExit = 1;
+void
+TclSetLibraryPath(pathPtr)
+    Tcl_Obj *pathPtr;		/* A Tcl list object whose elements are
+				 * the new library path. */
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    const char *toDupe;
+    int size;
 
-    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.
-	 */
+    if (pathPtr != NULL) {
+	Tcl_IncrRefCount(pathPtr);
+    }
+    if (tsdPtr->tclLibraryPath != NULL) {
+	Tcl_DecrRefCount(tsdPtr->tclLibraryPath);
+    }
+    tsdPtr->tclLibraryPath = pathPtr;
 
-	firstExitPtr = exitPtr->nextPtr;
-	Tcl_MutexUnlock(&exitMutex);
-	exitPtr->proc(exitPtr->clientData);
-	ckfree(exitPtr);
-	Tcl_MutexLock(&exitMutex);
+    /*
+     *  No mutex locking is needed here as up the stack we're within
+     *  TclpInitLock().
+     */
+    if (tclLibraryPathStr != NULL) {
+	ckfree(tclLibraryPathStr);
     }
-    firstExitPtr = NULL;
-    Tcl_MutexUnlock(&exitMutex);
+    toDupe = Tcl_GetStringFromObj(pathPtr, &size);
+    tclLibraryPathStr = ckalloc((unsigned)size+1);
+    memcpy(tclLibraryPathStr, toDupe, (unsigned)size+1);
 }
-
 
 /*
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
  *
- * Tcl_Exit --
+ * TclGetLibraryPath --
  *
- *	This function is called to terminate the application.
+ *	Return a Tcl list object whose elements are the library path.
+ *	The caller should not modify the contents of the returned object.
  *
  * Results:
- *	None.
+ *	As above.
  *
  * Side effects:
- *	All existing exit handlers are invoked, then the application ends.
+ *	None.
  *
- *----------------------------------------------------------------------
+ *-------------------------------------------------------------------------
  */
 
-void
-Tcl_Exit(
-    int status)			/* Exit status for application; typically 0
-				 * for normal return, 1 for error return. */
+Tcl_Obj *
+TclGetLibraryPath()
 {
-    Tcl_ExitProc *currentAppExitPtr;
-
-    Tcl_MutexLock(&exitMutex);
-    currentAppExitPtr = appExitPtr;
-    Tcl_MutexUnlock(&exitMutex);
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if (currentAppExitPtr) {
+    if (tsdPtr->tclLibraryPath == NULL) {
 	/*
-	 * 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.
+	 * Grab the shared string and place it into a new thread specific
+	 * Tcl_Obj.
 	 */
+	tsdPtr->tclLibraryPath = Tcl_NewStringObj(tclLibraryPathStr, -1);
 
-	currentAppExitPtr(INT2PTR(status));
-	Tcl_Panic("AppExitProc returned unexpectedly");
-    } else {
-
-	if (TclFullFinalizationRequested()) {
-
-	    /*
-	     * Thorough finalization for Valgrind et al.
-	     */
-
-	    Tcl_Finalize();
-
-	} else {
-
-	    /*
-	     * Fast and deterministic exit (default behavior)
-	     */
-	    
-	    InvokeExitHandlers();
-	    
-	    /*
-	     * Ensure the thread-specific data is initialised as it is used in
-	     * Tcl_FinalizeThread()
-	     */
-	    
-	    (void) TCL_TSD_INIT(&dataKey);
-	    
-	    /*
-	     * Now finalize the calling thread only (others are not safely
-	     * reachable).  Among other things, this triggers a flush of the
-	     * Tcl_Channels that may have data enqueued.
-	     */
-	    
-	    Tcl_FinalizeThread();
-	}
-	TclpExit(status);
-	Tcl_Panic("OS exit failed!");
+	/* take ownership */
+	Tcl_IncrRefCount(tsdPtr->tclLibraryPath);
     }
+    return tsdPtr->tclLibraryPath;
 }
 
 /*
@@ -995,16 +745,17 @@ Tcl_Exit(
  *
  * 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.
@@ -1016,55 +767,74 @@ Tcl_Exit(
  */
 
 void
-TclInitSubsystems(void)
+TclInitSubsystems(argv0)
+    CONST char *argv0;		/* Name of executable from argv[0] to main()
+				 * in native multi-byte encoding. */
 {
-    if (inExit != 0) {
-	Tcl_Panic("TclInitSubsystems called while exiting");
+    ThreadSpecificData *tsdPtr;
+
+    if (inFinalize != 0) {
+	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 functions below.
+	/* 
+	 * Double check inside the mutex.  There are definitly calls
+	 * back into this routine from some of the procedures 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) */
-	    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). */
+	    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) */
 	}
 	TclpInitUnlock();
     }
-    TclInitNotifier();
+
+    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();
+     }
 }
 
 /*
@@ -1072,9 +842,10 @@ TclInitSubsystems(void)
  *
  * Tcl_Finalize --
  *
- *	Shut down Tcl. First calls registered exit handlers, then carefully
- *	shuts down various subsystems.  Should be invoked by user before the
- *	Tcl shared library is being unloaded in an embedded context.
+ *	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.
@@ -1086,35 +857,50 @@ TclInitSubsystems(void)
  */
 
 void
-Tcl_Finalize(void)
+Tcl_Finalize()
 {
     ExitHandler *exitPtr;
-
+    
     /*
      * Invoke exit handlers first.
      */
 
-    InvokeExitHandlers();   
+    Tcl_MutexLock(&exitMutex);
+    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.
+	 */
+
+	firstExitPtr = exitPtr->nextPtr;
+	Tcl_MutexUnlock(&exitMutex);
+	(*exitPtr->proc)(exitPtr->clientData);
+	ckfree((char *) exitPtr);
+	Tcl_MutexLock(&exitMutex);
+    }    
+    firstExitPtr = NULL;
+    Tcl_MutexUnlock(&exitMutex);
 
     TclpInitLock();
-    if (subsystemsInitialized == 0) {
-	goto alreadyFinalized;
-    }
-    subsystemsInitialized = 0;
+    if (subsystemsInitialized != 0) {
+	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 or IO subsystem 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 after this call.
+	 */
 
     Tcl_FinalizeThread();
 
@@ -1123,8 +909,7 @@ Tcl_Finalize(void)
      */
 
     Tcl_MutexLock(&exitMutex);
-    for (exitPtr = firstLateExitPtr; exitPtr != NULL;
-	    exitPtr = firstLateExitPtr) {
+    for (exitPtr = firstLateExitPtr; exitPtr != NULL; exitPtr = firstLateExitPtr) {
 	/*
 	 * Be careful to remove the handler from the list before invoking its
 	 * callback. This protects us against double-freeing if the callback
@@ -1134,7 +919,7 @@ Tcl_Finalize(void)
 	firstLateExitPtr = exitPtr->nextPtr;
 	Tcl_MutexUnlock(&exitMutex);
 	exitPtr->proc(exitPtr->clientData);
-	ckfree(exitPtr);
+	ckfree((char *) exitPtr);
 	Tcl_MutexLock(&exitMutex);
     }
     firstLateExitPtr = NULL;
@@ -1145,114 +930,110 @@ Tcl_Finalize(void)
      * after the exit handlers, because there are order dependencies.
      */
 
-    TclFinalizeEvaluation();
-    TclFinalizeExecution();
-    TclFinalizeEnvironment();
-
-    /*
-     * Finalizing the filesystem must come after anything which might
-     * conceivably interact with the 'Tcl_FS' API.
-     */
-
-    TclFinalizeFilesystem();
+	TclFinalizeCompilation();
+	TclFinalizeExecution();
+	TclFinalizeEnvironment();
 
-    /*
-     * 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();
-
-    /*
-     * 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();
-
-    Tcl_SetPanicProc(NULL);
+	/* 
+	 * Finalizing the filesystem must come after anything which
+	 * might conceivably interact with the 'Tcl_FS' API. 
+	 */
 
-    /*
-     * 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.
-     */
+	TclFinalizeFilesystem();
 
-    TclFinalizeThreadData();
+	/*
+	 * 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.
+	 */
 
-    /*
-     * Now we can free constants for conversions to/from double.
-     */
+	TclFinalizeObjects();
 
-    TclFinalizeDoubleConversion();
+	/* 
+	 * 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();
 
-    /*
-     * 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_FinalizeMemorySubsystem or
-     * Tcl_FinalizeThreadAlloc will result in a corrupted heap. The result can
-     * be a mysterious crash on process exit. Check here that nobody's done
-     * this.
-     */
+	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);
 
-    if (firstExitPtr != NULL) {
-	Tcl_Panic("exit handlers were created during Tcl_Finalize");
-    }
+	/*
+	 * 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.
+	 */
 
-    TclFinalizePreserve();
+#ifdef TCL_MEM_DEBUG
+	if ( firstExitPtr != NULL ) {
+	    Tcl_Panic( "exit handlers were created during Tcl_Finalize" );
+	}
+#endif
 
-    /*
-     * Free synchronization objects. There really should only be one thread
-     * alive at this moment.
-     */
+	TclFinalizePreserve();
 
-    TclFinalizeSynchronization();
+	/*
+	 * Free synchronization objects.  There really should only be one
+	 * thread alive at this moment.
+	 */
 
-    /*
-     * Close down the thread-specific object allocator.
-     */
+	TclFinalizeSynchronization();
 
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-    TclFinalizeThreadAlloc();
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG) && !defined(PURIFY)
+	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.
-     */
-
-    TclFinalizeLoad();
-    TclResetFilesystem();
-
-    /*
-     * At this point, there should no longer be any ckalloc'ed memory.
-     */
+	/*
+	 * 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.
+	 */
 
-    TclFinalizeMemorySubsystem();
+	TclFinalizeLoad();
+	TclResetFilesystem();
+	
+	/*
+	 * At this point, there should no longer be any ckalloc'ed memory.
+	 */
 
-  alreadyFinalized:
+	TclFinalizeMemorySubsystem();
+	inFinalize = 0;
+    }
     TclFinalizeLock();
 }
 
@@ -1261,8 +1042,8 @@ Tcl_Finalize(void)
  *
  * 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.
@@ -1274,45 +1055,48 @@ Tcl_Finalize(void)
  */
 
 void
-Tcl_FinalizeThread(void)
+Tcl_FinalizeThread()
 {
     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 = TclThreadDataKeyGet(&dataKey);
+    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.
 	     */
 
 	    tsdPtr->firstExitPtr = exitPtr->nextPtr;
-	    exitPtr->proc(exitPtr->clientData);
-	    ckfree(exitPtr);
+	    (*exitPtr->proc)(exitPtr->clientData);
+	    ckfree((char *) exitPtr);
 	}
 	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]
      */
@@ -1337,9 +1121,9 @@ Tcl_FinalizeThread(void)
  */
 
 int
-TclInExit(void)
+TclInExit()
 {
-    return inExit;
+    return inFinalize;
 }
 
 /*
@@ -1359,14 +1143,15 @@ TclInExit(void)
  */
 
 int
-TclInThreadExit(void)
+TclInThreadExit()
 {
-    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
-
+    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+	    TclThreadDataKeyGet(&dataKey);
     if (tsdPtr == NULL) {
 	return 0;
+    } else {
+	return tsdPtr->inExit;
     }
-    return tsdPtr->inExit;
 }
 
 /*
@@ -1374,8 +1159,8 @@ TclInThreadExit(void)
  *
  * Tcl_VwaitObjCmd --
  *
- *	This function is invoked to process the "vwait" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "vwait" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1388,80 +1173,61 @@ TclInThreadExit(void)
 
 	/* ARGSUSED */
 int
-Tcl_VwaitObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int done, foundEvent;
-    const char *nameString;
+    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]);
     if (Tcl_TraceVar(interp, nameString,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    VwaitVarProc, &done) != TCL_OK) {
+	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
 	return TCL_ERROR;
     };
     done = 0;
     foundEvent = 1;
     while (!done && foundEvent) {
 	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
-	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
-	    break;
-	}
-	if (Tcl_LimitExceeded(interp)) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "limit exceeded", NULL);
-	    break;
-	}
     }
     Tcl_UntraceVar(interp, nameString,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    VwaitVarProc, &done);
-
-    if (!foundEvent) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
-		"\": would wait forever", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
-	return TCL_ERROR;
-    }
-    if (!done) {
-	/*
-	 * The interpreter's result was already set to the right error message
-	 * prior to exiting the loop above.
-	 */
-
-	return TCL_ERROR;
-    }
+	    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);
+	return TCL_ERROR;
+    }
     return TCL_OK;
 }
 
 	/* ARGSUSED */
 static char *
-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. */
+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. */
 {
-    int *donePtr = clientData;
+    int *donePtr = (int *) clientData;
 
     *donePtr = 1;
-    return NULL;
+    return (char *) NULL;
 }
 
 /*
@@ -1469,8 +1235,8 @@ VwaitVarProc(
  *
  * Tcl_UpdateObjCmd --
  *
- *	This function is invoked to process the "update" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "update" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1483,16 +1249,16 @@ VwaitVarProc(
 
 	/* ARGSUSED */
 int
-Tcl_UpdateObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int optionIndex;
     int flags = 0;		/* Initialized to avoid compiler warning. */
-    static const char *const updateOptions[] = {"idletasks", NULL};
-    enum updateOptions {OPT_IDLETASKS};
+    static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
+    enum updateOptions {REGEXP_IDLETASKS};
 
     if (objc == 1) {
 	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
@@ -1502,44 +1268,39 @@ Tcl_UpdateObjCmd(
 	    return TCL_ERROR;
 	}
 	switch ((enum updateOptions) optionIndex) {
-	case OPT_IDLETASKS:
-	    flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
-	    break;
-	default:
-	    Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
+	    case REGEXP_IDLETASKS: {
+		flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+		break;
+	    }
+	    default: {
+		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) {
-	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
-	    return TCL_ERROR;
-	}
-	if (Tcl_LimitExceeded(interp)) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "limit exceeded", NULL);
-	    return TCL_ERROR;
-	}
+	/* Empty loop body */
     }
 
     /*
-     * 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.
+ * 	Bootstrap function of a new Tcl thread.
  *
  * Results:
  *	None.
@@ -1547,39 +1308,38 @@ Tcl_UpdateObjCmd(
  * Side Effects:
  *	Initializes Tcl notifier for the current thread.
  *
- *----------------------------------------------------------------------
+ *-----------------------------------------------------------------------------
  */
 
 static Tcl_ThreadCreateType
-NewThreadProc(
-    ClientData clientData)
+NewThreadProc(ClientData clientData)
 {
-    ThreadClientData *cdPtr = clientData;
+    ThreadClientData *cdPtr;
     ClientData threadClientData;
     Tcl_ThreadCreateProc *threadProc;
 
+    cdPtr = (ThreadClientData*)clientData;
     threadProc = cdPtr->proc;
     threadClientData = cdPtr->clientData;
-    ckfree(clientData);		/* Allocated in Tcl_CreateThread() */
+    ckfree((char*)clientData); /* Allocated in Tcl_CreateThread() */
 
-    threadProc(threadClientData);
+    (*threadProc)(threadClientData);
 
     TCL_THREAD_CREATE_RETURN;
 }
 #endif
-
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_CreateThread --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -1588,34 +1348,24 @@ NewThreadProc(
  */
 
 int
-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. */
+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 */
 {
 #ifdef TCL_THREADS
-    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
-    int result;
+    ThreadClientData *cdPtr;
 
+    cdPtr = (ThreadClientData*)ckalloc(sizeof(ThreadClientData));
     cdPtr->proc = proc;
     cdPtr->clientData = clientData;
-    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
-    if (result != TCL_OK) {
-	ckfree(cdPtr);
-    }
-    return result;
+
+    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 e402634..3ca1b63 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1,49 +1,63 @@
-/*
+/* 
  * 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) 2002-2010 by Miguel Sofer.
- * Copyright (c) 2005-2007 by Donal K. Fellows.
- * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
- * Copyright (c) 2006-2008 by Joe Mistachkin.  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 "tclCompile.h"
-#include "tommath.h"
-#include <math.h>
 
-#if NRE_ENABLE_ASSERTS
-#include <assert.h>
+#ifndef TCL_NO_MATH
+#   include "tclMath.h"
 #endif
 
 /*
- * 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?
+ * 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.
  */
 
-#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
-#define IEEE_FLOATING_POINT
+#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
 #endif
 
 /*
- * 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.
+ * Need DBL_MAX for IS_INF() macro...
  */
-
-#ifndef ASYNC_CHECK_COUNT_MASK
-#   define ASYNC_CHECK_COUNT_MASK	63
-#endif /* !ASYNC_CHECK_COUNT_MASK */
+#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.
+ */
+#	define DBL_MAX 1.79769313486231570e+308
+#   endif /* MAXDOUBLE */
+#endif /* !DBL_MAX */
 
 /*
  * Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -53,8 +67,6 @@
 static int execInitialized = 0;
 TCL_DECLARE_MUTEX(execMutex)
 
-static int cachedInExit = 0;
-
 #ifdef TCL_COMPILE_DEBUG
 /*
  * Variable that controls whether execution tracing is enabled and, if so,
@@ -73,25 +85,22 @@ 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 *CONST 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 *CONST resultStrings[] = {
     "TCL_OK", "TCL_ERROR", "TCL_RETURN", "TCL_BREAK", "TCL_CONTINUE"
 };
 #endif
@@ -102,282 +111,147 @@ static const char *const resultStrings[] = {
 
 #ifdef TCL_COMPILE_STATS
 long		tclObjsAlloced = 0;
-long		tclObjsFreed = 0;
+long		tclObjsFreed   = 0;
+#define TCL_MAX_SHARED_OBJ_STATS 5
 long		tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
 #endif /* TCL_COMPILE_STATS */
 
 /*
- * Support pre-8.5 bytecodes unless specifically requested otherwise.
+ * 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.
  */
 
-#ifndef TCL_SUPPORT_84_BYTECODE
-#define TCL_SUPPORT_84_BYTECODE 1
-#endif
+#define IS_NAN(v) ((v) != (v))
+#define IS_INF(v) (((v) > DBL_MAX) || ((v) < -DBL_MAX))
 
-#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+.
- */
-
-typedef struct {
-    const char *name;		/* Name of function. */
-    int numArgs;		/* Number of arguments for function. */
-} BuiltinFunc;
-
-/*
- * 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 BuiltinFunc const 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
-
-/*
- * NR_TEBC
- * Helpers for NR - non-recursive calls to TEBC
- * Minimal data required to fully reconstruct the execution state.
- */
-
-typedef struct TEBCdata {
-    ByteCode *codePtr;		/* Constant until the BC returns */
-				/* -----------------------------------------*/
-    const unsigned char *pc;	/* These fields are used on return TO this */
-    ptrdiff_t *catchTop;	/* this level: they record the state when a */
-    int cleanup;		/* new codePtr was received for NR */
-    Tcl_Obj *auxObjList;	/* execution. */
-    int checkInterp;
-    CmdFrame cmdFrame;
-    void *stack[1];		/* Start of the actual combined catch and obj
-				 * stacks; the struct will be expanded as
-				 * necessary */
-} TEBCdata;
-
-#define TEBC_YIELD() \
-    do {								\
-	esPtr->tosPtr = tosPtr;						\
-	TD->pc = pc;							\
-	TD->cleanup = cleanup;						\
-	TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \
-    } while (0)
-
-#define TEBC_DATA_DIG() \
-    do {					\
-	pc = TD->pc;				\
-	cleanup = TD->cleanup;			\
-	tosPtr = esPtr->tosPtr;			\
-    } while (0)
-
-#define PUSH_TAUX_OBJ(objPtr) \
-    do {							\
-	objPtr->internalRep.ptrAndLongRep.ptr = auxObjList;	\
-	auxObjList = objPtr;					\
-    } while (0)
-
-#define POP_TAUX_OBJ() \
-    do {							\
-	tmpPtr = auxObjList;					\
-	auxObjList = tmpPtr->internalRep.ptrAndLongRep.ptr;	\
-	Tcl_DecrRefCount(tmpPtr);				\
-    } while (0)
-
-/*
- * 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(&tablePtr->table,
-	    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).
+ * 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
- *    resultHandling: 0 indicates no object should be pushed on the stack;
- *	otherwise, push objResultPtr. If (result < 0), objResultPtr already
- *	has the correct reference count.
- *
- * We use the new compile-time assertions to cheack that nCleanup is constant
- * and within range.
+ *    result: 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, resultHandling) \
-    do {							\
-	TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2));	\
-	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;		\
-	    }							\
-	} else {						\
-	    pc += (pcAdjustment);				\
-	    switch (nCleanup) {					\
-	    case 1: goto cleanup1;				\
-	    case 2: goto cleanup2;				\
-	    }							\
-	}							\
-    } while (0)
-
-#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \
-    do {							\
-	pc += (pcAdjustment);					\
-	cleanup = (nCleanup);					\
-	if (resultHandling) {					\
-	    if ((resultHandling) > 0) {				\
-		Tcl_IncrRefCount(objResultPtr);			\
-	    }							\
-	    goto cleanupV_pushObjResultPtr;			\
-	} else {						\
-	    goto cleanupV;					\
-	}							\
-    } while (0)
+#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) \
+    pc += (pcAdjustment);\
+    cleanup = (nCleanup);\
+    if (result) {\
+	if ((result) > 0) {\
+	    Tcl_IncrRefCount(objResultPtr);\
+	}\
+	goto cleanupV_pushObjResultPtr;\
+    } else {\
+	goto cleanupV;\
+    }
+
 
 /*
  * Macros used to cache often-referenced Tcl evaluation stack information
  * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO()
- * pair must surround any call inside TclNRExecuteByteCode (and a few other
+ * pair must surround any call inside TclExecuteByteCode (and a few other
  * procedures that use this scheme) that could result in a recursive call
- * to TclNRExecuteByteCode.
+ * to TclExecuteByteCode.
  */
 
 #define CACHE_STACK_INFO() \
-    checkInterp = 1
+    stackPtr = eePtr->stackPtr; \
+    stackTop = eePtr->stackTop
 
 #define DECACHE_STACK_INFO() \
-    esPtr->tosPtr = tosPtr
+    eePtr->stackTop = stackTop
+
 
 /*
  * 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(*(++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	((ptrdiff_t) (tosPtr - initTosPtr))
+    Tcl_IncrRefCount(stackPtr[++stackTop] = (objPtr))
+    
+#define POP_OBJECT() \
+    (stackPtr[stackTop--])
 
 /*
  * Macros used to trace instruction execution. The macros TRACE,
- * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. 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) \
-    while (traceInstructions) {					\
-	fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels,	\
-		(int) CURR_DEPTH,				\
-		(unsigned) (pc - codePtr->codeStart),		\
-		GetOpcodeName(pc));				\
-	printf a;						\
-	break;							\
+    if (traceInstructions) { \
+        fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
+	       (unsigned int)(pc - codePtr->codeStart), \
+	       GetOpcodeName(pc)); \
+	printf a; \
     }
 #   define TRACE_APPEND(a) \
-    while (traceInstructions) {		\
-	printf a;			\
-	break;				\
+    if (traceInstructions) { \
+	printf a; \
     }
 #   define TRACE_WITH_OBJ(a, objPtr) \
-    while (traceInstructions) {					\
-	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");					\
-	break;							\
+    if (traceInstructions) { \
+        fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, stackTop, \
+	       (unsigned int)(pc - codePtr->codeStart), \
+	       GetOpcodeName(pc)); \
+	printf a; \
+        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 */
@@ -387,343 +261,156 @@ VarHashCreateVar(
  */
 
 #define TCL_DTRACE_INST_NEXT() \
-    do {								\
-	if (TCL_DTRACE_INST_DONE_ENABLED()) {				\
-	    if (curInstName) {						\
-		TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH,	\
-			tosPtr);					\
-	    }								\
-	    curInstName = tclInstructionTable[*pc].name;		\
-	    if (TCL_DTRACE_INST_START_ENABLED()) {			\
-		TCL_DTRACE_INST_START(curInstName, (int) CURR_DEPTH,	\
-			tosPtr);					\
-	    }								\
-	} else if (TCL_DTRACE_INST_START_ENABLED()) {			\
-	    TCL_DTRACE_INST_START(tclInstructionTable[*pc].name,	\
-			(int) CURR_DEPTH, tosPtr);			\
-	}								\
-    } while (0)
+    if (TCL_DTRACE_INST_DONE_ENABLED()) {\
+	if (curInstName) {\
+	    TCL_DTRACE_INST_DONE(curInstName, stackTop - initStackTop,\
+		    stackPtr + stackTop);\
+	}\
+	curInstName = tclInstructionTable[*pc].name;\
+	if (TCL_DTRACE_INST_START_ENABLED()) {\
+	    TCL_DTRACE_INST_START(curInstName, stackTop - initStackTop,\
+		    stackPtr + stackTop);\
+	}\
+    } else if (TCL_DTRACE_INST_START_ENABLED()) {\
+	TCL_DTRACE_INST_START(tclInstructionTable[*pc].name,\
+		stackTop - initStackTop, stackPtr + stackTop);\
+    }
 #define TCL_DTRACE_INST_LAST() \
-    do {								\
-	if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {		\
-	    TCL_DTRACE_INST_DONE(curInstName, (int) CURR_DEPTH, tosPtr);\
-	}								\
-    } while (0)
-
-/*
- * Macro used in this file to save a function call for common uses of
- * TclGetNumberFromObj(). The ANSI C "prototype" is:
- *
- * MODULE_SCOPE int GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- *			ClientData *ptrPtr, int *tPtr);
- */
-
-#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 /* !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 == &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 /* NO_WIDE_TYPE */
-
-/*
- * 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 TclGetBooleanFromObj(interp, objPtr, boolPtr) \
-    ((((objPtr)->typePtr == &tclIntType)				\
-	|| ((objPtr)->typePtr == &tclBooleanType))			\
-	? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
-	: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
-
-/*
- * 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);
- */
-
-#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 /* !NO_WIDE_TYPE */
-#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 /* NO_WIDE_TYPE */
-
-/*
- * 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 Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0))
-
-/*
- * Macro for checking whether the type is NaN, used when we're thinking about
- * throwing an error for supplying a non-number number.
- */
-
-#ifndef ACCEPT_NAN
-#define IsErroringNaNType(type)		((type) == TCL_NUMBER_NAN)
-#else
-#define IsErroringNaNType(type)		0
-#endif
-
-/*
- * 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);
+    if (TCL_DTRACE_INST_DONE_ENABLED() && curInstName) {\
+	TCL_DTRACE_INST_DONE(curInstName, stackTop - initStackTop,\
+		stackPtr + stackTop);\
+    }
 
 /*
- * 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.
+ * 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.
+ *
+ * GET_WIDE_OR_INT is the same as REQUIRE_WIDE_OR_INT except it never
+ * generates an error message.
  */
-
-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)
-
+#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);				\
+    }
 /*
- * Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
- * Tcl_WideInt.
+ * Combined with REQUIRE_WIDE_OR_INT, this gets a long value from
+ * an obj.
  */
+#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)
 
-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);
-
+#define W0	Tcl_LongAsWide(0)
 /*
- * Table giving 3, 4, ..., 13 raised to powers greater than 16 when the
- * results fit in a 64-bit signed integer.
+ * For tracing that uses wide values.
  */
+#define LLD				"%" TCL_LL_MODIFIER "d"
 
-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 /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */
-
+#ifndef TCL_WIDE_INT_IS_LONG
 /*
- * Markers for ExecuteExtendedBinaryMathOp.
+ * Extract a double value from a general numeric object.
  */
+#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 DIVIDED_BY_ZERO		((Tcl_Obj *) -1)
-#define EXPONENT_OF_ZERO	((Tcl_Obj *) -2)
-#define GENERAL_ARITHMETIC_ERROR ((Tcl_Obj *) -3)
-
 /*
  * 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(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
+static int              EvalStatsCmd _ANSI_ARGS_((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 const char *	GetOpcodeName(const unsigned char *pc);
-static void		PrintByteCodeInfo(ByteCode *codePtr);
-static const char *	StringForResultCode(int result);
-static void		ValidatePcAndStackTop(ByteCode *codePtr,
-			    const unsigned char *pc, int stackTop,
-			    int stackLowerBound, int checkStack);
+static char *		GetOpcodeName _ANSI_ARGS_((unsigned char *pc));
 #endif /* TCL_COMPILE_DEBUG */
-static ByteCode *	CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static void		DeleteExecStack(ExecStack *esPtr);
-static void		DupExprCodeInternalRep(Tcl_Obj *srcPtr,
-			    Tcl_Obj *copyPtr);
-MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
-			    Tcl_Obj *value2Ptr);
-static Tcl_Obj *	ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
-			    int opcode, Tcl_Obj **constants,
-			    Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
-static Tcl_Obj *	ExecuteExtendedUnaryMathOp(int opcode,
-			    Tcl_Obj *valuePtr);
-static void		FreeExprCodeInternalRep(Tcl_Obj *objPtr);
-static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
-			    int catchOnly, ByteCode *codePtr);
-static const char *	GetSrcInfoForPc(const unsigned char *pc,
-			    ByteCode *codePtr, int *lengthPtr,
-			    const unsigned char **pcBeg);
-static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, int growth,
-			    int move);
-static void		IllegalExprOperandType(Tcl_Interp *interp,
-			    const unsigned char *pc, Tcl_Obj *opndPtr);
-static void		InitByteCodeExecution(Tcl_Interp *interp);
-static inline int	OFFSET(void *ptr);
-static void		ReleaseDictIterator(Tcl_Obj *objPtr);
-/* 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);
-static Tcl_NRPostProc	CopyCallback;
-static Tcl_NRPostProc	ExprObjCallback;
-
-static Tcl_NRPostProc   TEBCresume;
+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));
+#endif /* TCL_COMPILE_DEBUG */
+static int		VerifyExprObjType _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Obj *objPtr));
 
 /*
  * The structure below defines a bytecode Tcl object type to hold the
  * compiled bytecode for Tcl expressions.
  */
 
-static const Tcl_ObjType exprCodeType = {
+static Tcl_ObjType exprCodeType = {
     "exprcode",
     FreeExprCodeInternalRep,	/* freeIntRepProc */
     DupExprCodeInternalRep,	/* dupIntRepProc */
@@ -732,58 +419,46 @@ static const Tcl_ObjType exprCodeType = {
 };
 
 /*
- * Custom object type only used in this file; values of its type should never
- * be seen by user scripts.
+ * 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 Tcl_ObjType dictIteratorType = {
-    "dictIterator",
-    ReleaseDictIterator,
-    NULL, NULL, NULL
+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},
 };
 
 /*
  *----------------------------------------------------------------------
  *
- * ReleaseDictIterator --
- *
- *	This takes apart a dictionary iterator that is stored in the given Tcl
- *	object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Deallocates memory, marks the object as being untyped.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ReleaseDictIterator(
-    Tcl_Obj *objPtr)
-{
-    Tcl_DictSearch *searchPtr;
-    Tcl_Obj *dictPtr;
-
-    /*
-     * First kill the search, and then release the reference to the dictionary
-     * that we were holding.
-     */
-
-    searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    Tcl_DictObjDone(searchPtr);
-    ckfree(searchPtr);
-
-    dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
-    TclDecrRefCount(dictPtr);
-
-    objPtr->typePtr = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * InitByteCodeExecution --
  *
  *	This procedure is called once to initialize the Tcl bytecode
@@ -794,28 +469,29 @@ ReleaseDictIterator(
  *
  * 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(
-    Tcl_Interp *interp)		/* Interpreter for which the Tcl variable
+InitByteCodeExecution(interp)
+    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) {
-	Tcl_Panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
+		    TCL_LINK_INT) != TCL_OK) {
+	panic("InitByteCodeExecution: can't create link for tcl_traceExec variable");
     }
 #endif
-#ifdef TCL_COMPILE_STATS
-    Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd, NULL, NULL);
+#ifdef TCL_COMPILE_STATS    
+    Tcl_CreateObjCommand(interp, "evalstats", EvalStatsCmd,
+	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
 #endif /* TCL_COMPILE_STATS */
 }
 
@@ -825,48 +501,52 @@ InitByteCodeExecution(
  * 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 TclNRExecuteByteCode 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 TclNRExecuteByteCode.
+ *	The bytecode interpreter is also initialized here, as this
+ *	procedure will be called before any call to TclExecuteByteCode.
  *
  *----------------------------------------------------------------------
  */
 
+#define TCL_STACK_INITIAL_SIZE 2000
+
 ExecEnv *
-TclCreateExecEnv(
-    Tcl_Interp *interp,		/* Interpreter for which the execution
+TclCreateExecEnv(interp)
+    Tcl_Interp *interp;		/* Interpreter for which the execution
 				 * environment is being created. */
-    int size)			/* The initial stack size, in number of words
-				 * [sizeof(Tcl_Obj*)] */
 {
-    ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
-    ExecStack *esPtr = ckalloc(sizeof(ExecStack)
-	    + (size_t) (size-1) * 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]);
-    eePtr->interp = interp;
-    eePtr->callbackPtr = NULL;
-    eePtr->corPtr = NULL;
-    eePtr->rewind = 0;
-
-    esPtr->prevPtr = NULL;
-    esPtr->nextPtr = NULL;
-    esPtr->markerPtr = NULL;
-    esPtr->endPtr = &esPtr->stackWords[size-1];
-    esPtr->tosPtr = &esPtr->stackWords[-1];
+    ExecEnv *eePtr = (ExecEnv *) ckalloc(sizeof(ExecEnv));
+    Tcl_Obj **stackPtr;
+
+    stackPtr = (Tcl_Obj **)
+	ckalloc((size_t) (TCL_STACK_INITIAL_SIZE * sizeof(Tcl_Obj *)));
+
+    /*
+     * 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);
 
     Tcl_MutexLock(&execMutex);
     if (!execInitialized) {
@@ -878,6 +558,7 @@ TclCreateExecEnv(
 
     return eePtr;
 }
+#undef TCL_STACK_INITIAL_SIZE
 
 /*
  *----------------------------------------------------------------------
@@ -890,59 +571,24 @@ TclCreateExecEnv(
  *	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 && !cachedInExit) {
-	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(esPtr);
-}
-
 void
-TclDeleteExecEnv(
-    ExecEnv *eePtr)		/* Execution environment to free. */
+TclDeleteExecEnv(eePtr)
+    ExecEnv *eePtr;		/* Execution environment to free. */
 {
-    ExecStack *esPtr = eePtr->execStackPtr, *tmpPtr;
-
-	cachedInExit = TclInExit();
-
-    /*
-     * Delete all stacks in this exec env.
-     */
-
-    while (esPtr->nextPtr) {
-	esPtr = esPtr->nextPtr;
-    }
-    while (esPtr) {
-	tmpPtr = esPtr;
-	esPtr = tmpPtr->prevPtr;
-	DeleteExecStack(tmpPtr);
-    }
-
-    TclDecrRefCount(eePtr->constants[0]);
-    TclDecrRefCount(eePtr->constants[1]);
-    if (eePtr->callbackPtr && !cachedInExit) {
-	Tcl_Panic("Deleting execEnv with pending TEOV callbacks!");
-    }
-    if (eePtr->corPtr && !cachedInExit) {
-	Tcl_Panic("Deleting execEnv with existing coroutine");
+    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");
     }
-    ckfree(eePtr);
+    TclDecrRefCount(eePtr->errorInfo);
+    TclDecrRefCount(eePtr->errorCode);
+    ckfree((char *) eePtr);
 }
 
 /*
@@ -950,21 +596,21 @@ TclDeleteExecEnv(
  *
  * 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(void)
+TclFinalizeExecution()
 {
     Tcl_MutexLock(&execMutex);
     execInitialized = 0;
@@ -973,336 +619,69 @@ TclFinalizeExecution(void)
 }
 
 /*
- * 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,
- *	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.
+ *	This procedure grows a Tcl evaluation stack stored in an ExecEnv.
  *
  * Results:
- *	Returns a pointer to the first usable word in the (possibly) grown
- *	stack.
+ *	None.
  *
  * Side effects:
- *	The size of the evaluation stack may be grown, a marker is set
+ *	The size of the evaluation stack is doubled.
  *
  *----------------------------------------------------------------------
  */
 
-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;
-	}
-    }
-
-    /*
-     * 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.
-     */
-
-    if (move) {
-	moveWords = esPtr->tosPtr - MEMSTART(markerPtr) + 1;
-    }
-    needed = growth + moveWords + WALLOCALIGN;
-
-    /*
-     * Check if there is enough room in the next stack (if there is one, it
-     * should be both empty and the last one!)
-     */
-
-    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];
-    }
-
-    /*
-     * We need to allocate a new stack! It needs to store 'growth' words,
-     * including the elements to be copied over and the new marker.
-     */
-
-    newElems = 2*currElems;
-    while (needed > newElems) {
-	newElems *= 2;
-    }
-    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);
-
-    oldPtr = esPtr;
-    esPtr = ckalloc(newBytes);
-
-    oldPtr->nextPtr = esPtr;
-    esPtr->prevPtr = oldPtr;
-    esPtr->nextPtr = NULL;
-    esPtr->endPtr = &esPtr->stackWords[newElems-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)
+static void
+GrowEvaluationStack(eePtr)
+    register ExecEnv *eePtr; /* Points to the ExecEnv with an evaluation
+			      * stack to enlarge. */
 {
     /*
-     * Note that GrowEvaluationStack sets a marker in the stack. This marker
-     * is read when rewinding, e.g., by TclStackFree.
+     * The current Tcl stack elements are stored from eePtr->stackPtr[0]
+     * to eePtr->stackPtr[eePtr->stackEnd] (inclusive).
      */
 
-    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, *marker;
-
-    if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
-	Tcl_Free((char *) freePtr);
-	return;
-    }
+    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;
 
     /*
-     * 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.
+     * We keep the stack reference count as a (char *), as that
+     * works nicely as a portable pointer-sized counter.
      */
 
-    eePtr = iPtr->execEnvPtr;
-    esPtr = eePtr->execStackPtr;
-    markerPtr = esPtr->markerPtr;
-    marker = *markerPtr;
-
-    if ((freePtr != NULL) && (MEMSTART(markerPtr) != (Tcl_Obj **)freePtr)) {
-	Tcl_Panic("TclStackFree: incorrect freePtr (%p != %p). Call out of sequence?",
-		freePtr, MEMSTART(markerPtr));
-    }
-
-    esPtr->tosPtr = markerPtr - 1;
-    esPtr->markerPtr = (Tcl_Obj **) marker;
-    if (marker) {
-	return;
-    }
+    char *refCount = (char *) oldStackPtr[-1];
 
     /*
-     * Return to previous active stack. Note that repeated expansions or
-     * reallocs could have generated several unused intervening stacks: free
-     * them too.
+     * 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.
      */
+ 
+    newStackPtr++;
+    memcpy((VOID *) newStackPtr, (VOID *) oldStackPtr,
+	   (size_t) currBytes);
 
-    while (esPtr->nextPtr) {
-	esPtr = esPtr->nextPtr;
-    }
-    esPtr->tosPtr = &esPtr->stackWords[-1];
-    while (esPtr->prevPtr) {
-	ExecStack *tmpPtr = esPtr->prevPtr;
-	if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) {
-	    DeleteExecStack(tmpPtr);
-	} else {
-	    break;
-	}
-    }
-    if (esPtr->prevPtr) {
-	eePtr->execStackPtr = esPtr->prevPtr;
+    if (refCount == (char *) 1) {
+	ckfree((VOID *) (oldStackPtr-1));
     } else {
-	eePtr->execStackPtr = 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 *) Tcl_Alloc(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 *) Tcl_Realloc((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?");
+	/*
+	 * Remove the reference corresponding to the
+	 * environment pointer.
+	 */
+	
+	oldStackPtr[-1] = (Tcl_Obj *) (refCount-1);
     }
 
-    numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
-    return (void *) StackReallocWords(interp, numWords);
+    eePtr->stackPtr = newStackPtr;
+    eePtr->stackEnd = (newElems - 2); /* index of last usable item */
+    newStackPtr[-1] = (Tcl_Obj *) ((char *) 1);	
 }
 
 /*
@@ -1313,212 +692,203 @@ TclStackRealloc(
  *	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(
-    Tcl_Interp *interp,		/* Context in which to evaluate the
+Tcl_ExprObj(interp, objPtr, resultPtrPtr)
+    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. */
 {
-    NRE_callback *rootPtr = TOP_CB(interp);
-    Tcl_Obj *resultPtr;
-
-    TclNewObj(resultPtr);
-    TclNRAddCallback(interp, CopyCallback, resultPtrPtr, resultPtr,
-	    NULL, NULL);
-    Tcl_NRExprObj(interp, objPtr, resultPtr);
-    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
-}
+    Interp *iPtr = (Interp *) interp;
+    CompileEnv compEnv;		/* Compilation environment structure
+				 * allocated in frame. */
+    LiteralTable *localTablePtr = &(compEnv.localLitTable);
+    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;
 
-static int
-CopyCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj **resultPtrPtr = data[0];
-    Tcl_Obj *resultPtr = data[1];
+    /*
+     * First handle some common expressions specially.
+     */
 
-    if (result == TCL_OK) {
-	*resultPtrPtr = resultPtr;
-	Tcl_IncrRefCount(resultPtr);
-    } else {
-	Tcl_DecrRefCount(resultPtr);
+    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;
+	}
     }
-    return result;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tcl_NRExprObj --
- *
- *	Request evaluation of the expression in a Tcl_Obj by the NR stack.
- *
- * Results:
- *	Returns TCL_OK.
- *
- * Side effects:
- *	Compiles objPtr as a Tcl expression and places callbacks on the
- *	NR stack to execute the bytecode and store the result in resultPtr.
- *	If bytecode execution raises an exception, nothing is written
- *	to resultPtr, and the exceptional return code flows up the NR
- *	stack.  If the exception is TCL_ERROR, an error message is left
- *	in the interp result and the interp's return options dictionary
- *	holds additional error information too.  Execution of the bytecode
- *	may have other side effects, depending on the expression.
- *
- *--------------------------------------------------------------
- */
-
-int
-Tcl_NRExprObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    Tcl_Obj *resultPtr)
-{
-    ByteCode *codePtr;
-
-    /* TODO: consider saving whole state? */
-    Tcl_Obj *saveObjPtr = Tcl_GetObjResult(interp);
 
+    /*
+     * Compile and execute the expression after saving the interp's result.
+     */
+    
+    saveObjPtr = Tcl_GetObjResult(interp);
     Tcl_IncrRefCount(saveObjPtr);
 
-    codePtr = CompileExprObj(interp, objPtr);
-
-    /* TODO: Confirm reset not required? */
-    /*Tcl_ResetResult(interp);*/
-    Tcl_NRAddCallback(interp, ExprObjCallback, saveObjPtr, resultPtr,
-	    NULL, NULL);
-    return TclNRExecuteByteCode(interp, codePtr);
-}
-
-static int
-ExprObjCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj *saveObjPtr = data[0];
-    Tcl_Obj *resultPtr = data[1];
-
-    if (result == TCL_OK) {
-	TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
-	Tcl_SetObjResult(interp, saveObjPtr);
-    }
-    TclDecrRefCount(saveObjPtr);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CompileExprObj --
- *	Compile a Tcl expression value into ByteCode.
- *
- * Results:
- *	A (ByteCode *) is returned pointing to the resulting ByteCode.
- *	The caller must manage its refCount and arrange for a call to
- *	TclCleanupByteCode() when the last reference disappears.
- *
- * Side effects:
- *	The Tcl_ObjType of objPtr is changed to the "bytecode" type,
- *	and the ByteCode is kept in the internal rep (along with context
- *	data for checking validity) for faster operations the next time
- *	CompileExprObj is called on the same value.
- *
- *----------------------------------------------------------------------
- */
-
-static ByteCode *
-CompileExprObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr)
-{
-    Interp *iPtr = (Interp *) interp;
-    CompileEnv compEnv;		/* Compilation environment structure allocated
-				 * in frame. */
-    register ByteCode *codePtr = NULL;
-				/* Tcl Internal type of bytecode. Initialized
-				 * to avoid compiler warning. */
-
     /*
      * 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->nsPtr;
+	Namespace *namespacePtr = iPtr->varFramePtr ?
+		iPtr->varFramePtr->nsPtr : iPtr->globalNsPtr;
 
-	codePtr = objPtr->internalRep.otherValuePtr;
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
-		|| (codePtr->compileEpoch != iPtr->compileEpoch)
-		|| (codePtr->nsPtr != namespacePtr)
-		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
-		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
-	    FreeExprCodeInternalRep(objPtr);
+	        || (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);
+
 	/*
-	 * TIP #280: No invoker (yet) - Expression compilation.
+	 * Free the compilation environment's literal table bucket array if
+	 * it was dynamically allocated. 
 	 */
 
-	int length;
-	const char *string = TclGetStringFromObj(objPtr, &length);
+	if (localTablePtr->buckets != localTablePtr->staticBuckets) {
+	    ckfree((char *) localTablePtr->buckets);
+	}
+    
+	if (result != TCL_OK) {
+	    /*
+	     * Compilation errors. Free storage allocated for compilation.
+	     */
 
-	TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
-	TclCompileExpr(interp, string, length, &compEnv, 0);
+#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;
+	}
 
 	/*
-	 * 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(TclRegisterNewLiteral(&compEnv, "0", 1),
-		    &compEnv);
+	    TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, /*onHeap*/ 0),
+	            &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 = objPtr->internalRep.otherValuePtr;
-	if (iPtr->varFramePtr->localCachePtr) {
-	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
-	    codePtr->localCachePtr->refCount++;
-	}
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
 #ifdef TCL_COMPILE_DEBUG
 	if (tclTraceCompile == 2) {
 	    TclPrintByteCodeObj(interp, objPtr);
-	    fflush(stdout);
 	}
 #endif /* TCL_COMPILE_DEBUG */
     }
-    return codePtr;
+
+    Tcl_ResetResult(interp);
+
+    /*
+     * 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 (result == TCL_OK) {
+	*resultPtrPtr = iPtr->objResultPtr;
+	Tcl_IncrRefCount(iPtr->objResultPtr);
+	
+	Tcl_SetObjResult(interp, saveObjPtr);
+    }
+done:
+    TclDecrRefCount(saveObjPtr);
+    return result;
 }
 
 /*
@@ -1527,17 +897,17 @@ CompileExprObj(
  * DupExprCodeInternalRep --
  *
  *	Part of the Tcl object type implementation for Tcl expression
- *	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.
- *
- *	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.
+ *	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.
+ *
+ *	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.
  *
  * Results:
  *	None.
@@ -1562,15 +932,14 @@ DupExprCodeInternalRep(
  * FreeExprCodeInternalRep --
  *
  *	Part of the Tcl object type implementation for Tcl expression
- *	bytecode. Frees the storage allocated to hold the internal rep, unless
- *	ref counts indicate bytecode execution is still in progress.
+ *	bytecode.  Frees the storage allocated to hold the internal rep,
+ *	unless ref counts indicate bytecode execution is still in progress.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	May free allocated memory. Leaves objPtr untyped.
- *
+ *	May free allocated memory.  Leaves objPtr untyped.
  *----------------------------------------------------------------------
  */
 
@@ -1578,797 +947,447 @@ static void
 FreeExprCodeInternalRep(
     Tcl_Obj *objPtr)
 {
-    ByteCode *codePtr = objPtr->internalRep.otherValuePtr;
+    ByteCode *codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
 
-    objPtr->typePtr = NULL;
-    objPtr->internalRep.otherValuePtr = NULL;
     codePtr->refCount--;
     if (codePtr->refCount <= 0) {
 	TclCleanupByteCode(codePtr);
     }
+    objPtr->typePtr = NULL;
+    objPtr->internalRep.otherValuePtr = NULL;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileObj --
+ * TclCompEvalObj --
  *
- *	This procedure compiles the script contained in a Tcl_Obj.
+ *	This procedure evaluates the script contained in a Tcl_Obj by 
+ *      first compiling it and then passing it to TclExecuteByteCode.
  *
  * Results:
- *	A pointer to the corresponding ByteCode, never NULL.
+ *	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:
- *	The object is shimmered to bytecode type.
+ *	Almost certainly, depending on the ByteCode's instructions.
  *
  *----------------------------------------------------------------------
  */
 
-ByteCode *
-TclCompileObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    const CmdFrame *invoker,
-    int word)
+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
 {
     register Interp *iPtr = (Interp *) interp;
-    register ByteCode *codePtr;	/* Tcl Internal type of bytecode. */
-    Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
+    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;
+    int result;
+    Namespace *namespacePtr;
+
 
     /*
-     * 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.
+     * Check that the interpreter is ready to execute scripts
      */
 
-    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.
-	 *
-	 * 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.
-	 */
+    iPtr->numLevels++;
+    if (TclInterpReady(interp) == TCL_ERROR) {
+	iPtr->numLevels--;
+	return TCL_ERROR;
+    }
 
-	codePtr = objPtr->internalRep.otherValuePtr;
-	if (((Interp *) *codePtr->interpHandle != iPtr)
-		|| (codePtr->compileEpoch != iPtr->compileEpoch)
-		|| (codePtr->nsPtr != namespacePtr)
-		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)) {
-	    if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
-		goto recompileObj;
-	    }
-	    if ((Interp *) *codePtr->interpHandle != iPtr) {
-		Tcl_Panic("Tcl_EvalObj: compiled script jumped interps");
-	    }
-	    codePtr->compileEpoch = iPtr->compileEpoch;
-	}
+    if (iPtr->varFramePtr != NULL) {
+        namespacePtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        namespacePtr = iPtr->globalNsPtr;
+    }
 
-	/*
-	 * Check that any compiled locals do refer to the current proc
-	 * environment! If not, recompile.
+    /* 
+     * 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.
 	 */
 
-	if (!(codePtr->flags & TCL_BYTECODE_PRECOMPILED) &&
-		(codePtr->procPtr == NULL) &&
-		(codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)){
-	    goto recompileObj;
-	}
+	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 {
 	/*
-	 * #280.
-	 * Literal sharing fix. This part of the fix is not required by 8.4
-	 * nor 8.5, because they eval-direct any literals, so just saving the
-	 * argument locations per command in bytecode is enough, embedded
-	 * 'eval' commands, etc. get the correct information.
-	 *
-	 * But 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.
+	 * 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.
 	 *
-	 * (3) Alternative 2: Do not fully recompile, adjust just the location
-	 *     information.
+	 * 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.
 	 */
-
-	if (invoker == NULL) {
-	    return codePtr;
-	} else {
-	    Tcl_HashEntry *hePtr =
-		    Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
-	    ExtCmdLoc *eclPtr;
-	    CmdFrame *ctxCopyPtr;
-	    int redo;
-
-	    if (!hePtr) {
-		return codePtr;
-	    }
-
-	    eclPtr = Tcl_GetHashValue(hePtr);
-	    redo = 0;
-	    ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
-	    *ctxCopyPtr = *invoker;
-
-	    if (invoker->type == TCL_LOCATION_BC) {
-		/*
-		 * Note: Type BC => ctx.data.eval.path    is not used.
-		 *		    ctx.data.tebc.codePtr used instead
-		 */
-
-		TclGetSrcInfoForPc(ctxCopyPtr);
-		if (ctxCopyPtr->type == TCL_LOCATION_SOURCE) {
-		    /*
-		     * The reference made by 'TclGetSrcInfoForPc' is dead.
-		     */
-
-		    Tcl_DecrRefCount(ctxCopyPtr->data.eval.path);
-		    ctxCopyPtr->data.eval.path = NULL;
-		}
-	    }
-
-	    if (word < ctxCopyPtr->nline) {
+	codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
+	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 {
 		/*
-		 * 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 ...).
+		 * This byteCode is invalid: free it and recompile
 		 */
-
-		redo = ((eclPtr->type == TCL_LOCATION_SOURCE)
-			    && (eclPtr->start != ctxCopyPtr->line[word]))
-			|| ((eclPtr->type == TCL_LOCATION_BC)
-			    && (ctxCopyPtr->type == TCL_LOCATION_SOURCE));
-	    }
-
-	    TclStackFree(interp, ctxCopyPtr);
-	    if (!redo) {
-		return codePtr;
+                tclByteCodeType.freeIntRepProc(objPtr);
+		goto recompileObj;
 	    }
 	}
     }
 
-  recompileObj:
-    iPtr->errorLine = 1;
-
     /*
-     * 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.
+     * Execute the commands. If the code was compiled from an empty string,
+     * don't bother executing the code.
      */
 
-    iPtr->invokeCmdFramePtr = invoker;
-    iPtr->invokeWord = word;
-    TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
-    iPtr->invokeCmdFramePtr = NULL;
-    codePtr = objPtr->internalRep.otherValuePtr;
-    if (iPtr->varFramePtr->localCachePtr) {
-	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
-	codePtr->localCachePtr->refCount++;
-    }
-    return codePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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) {
+    numSrcBytes = codePtr->numSrcBytes;
+    if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
 	/*
-	 * Produce error message (reparse?!)
+	 * Increment the code's ref count while it is being executed. If
+	 * afterwards no references to it remain, free the code.
 	 */
-
-	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;
+	
+	codePtr->refCount++;
+	result = TclExecuteByteCode(interp, codePtr);
+	codePtr->refCount--;
+	if (codePtr->refCount <= 0) {
+	    TclCleanupByteCode(codePtr);
 	}
-#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
-    }
-
-    if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
-	/*
-	 * Produce error message (reparse?!)
-	 */
-
-	return TclGetIntFromObj(interp, valuePtr, &type1);
+    } else {
+	result = TCL_OK;
     }
-    if ((type2 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_NAN)) {
-	/*
-	 * Produce error message (reparse?!)
-	 */
+    iPtr->numLevels--;
 
-	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;
+    /*
+     * 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.
+     */
 
-	TclGetWideIntFromObj(NULL, valuePtr, &w1);
-	TclGetWideIntFromObj(NULL, incrPtr, &w2);
-	sum = w1 + w2;
+    if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
+	result = Tcl_AsyncInvoke(interp, result);
+    
 
 	/*
-	 * Check for overflow.
+	 * If an error occurred, record information about what was being
+	 * executed when the error occurred.
 	 */
-
-	if (!Overflowing(w1, w2, sum)) {
-	    Tcl_SetWideIntObj(valuePtr, sum);
-	    return TCL_OK;
+	
+	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
 	}
     }
-#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;
+    /*
+     * 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. 
+     */
+
+    iPtr->termOffset = numSrcBytes;
+    iPtr->flags &= ~ERR_ALREADY_LOGGED;
+
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclNRExecuteByteCode --
+ * 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.
  *
  *----------------------------------------------------------------------
  */
-#define	bcFramePtr	(&TD->cmdFrame)
-#define	initCatchTop	((ptrdiff_t *) (&TD->stack[-1]))
-#define	initTosPtr	((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
-#define esPtr		(iPtr->execEnvPtr->execStackPtr)
-
-int
-TclNRExecuteByteCode(
-    Tcl_Interp *interp,		/* Token for command interpreter. */
-    ByteCode *codePtr)		/* The bytecode sequence to interpret. */
+ 
+static int
+TclExecuteByteCode(interp, codePtr)
+    Tcl_Interp *interp;		/* Token for command interpreter. */
+    ByteCode *codePtr;		/* The bytecode sequence to interpret. */
 {
     Interp *iPtr = (Interp *) interp;
-    TEBCdata *TD;
-    int size = sizeof(TEBCdata) - 1
-	    + (codePtr->maxStackDepth + codePtr->maxExceptDepth)
-		* sizeof(void *);
-    int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
-
-    if (iPtr->execEnvPtr->rewind) {
-	return TCL_ERROR;
-    }
-
-    codePtr->refCount++;
-
-    /*
-     * Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
-     *
-     * The execution uses a unified stack: first a TEBCdata, immediately
-     * above it a CmdFrame, then the catch stack, 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.
-     */
-
-    TD = (TEBCdata *) GrowEvaluationStack(iPtr->execEnvPtr, numWords, 0);
-    esPtr->tosPtr = initTosPtr;
-
-    TD->codePtr     = codePtr;
-    TD->pc	    = codePtr->codeStart;
-    TD->catchTop    = initCatchTop;
-    TD->cleanup     = 0;
-    TD->auxObjList  = NULL;
-    TD->checkInterp = 0;
-
-    /*
-     * TIP #280: Initialize the frame. Do not push it yet: it will be pushed
-     * every time that we call out from this TD, popped when we return to it.
-     */
-
-    bcFramePtr->type = ((codePtr->flags & TCL_BYTECODE_PRECOMPILED)
-	    ? TCL_LOCATION_PREBC : TCL_LOCATION_BC);
-    bcFramePtr->level = (iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level+1 : 1);
-    bcFramePtr->numLevels = iPtr->numLevels;
-    bcFramePtr->framePtr = iPtr->framePtr;
-    bcFramePtr->nextPtr = iPtr->cmdFramePtr;
-    bcFramePtr->nline = 0;
-    bcFramePtr->line = NULL;
-    bcFramePtr->litarg = NULL;
-    bcFramePtr->data.tebc.codePtr = codePtr;
-    bcFramePtr->data.tebc.pc = NULL;
-    bcFramePtr->cmd.str.cmd = NULL;
-    bcFramePtr->cmd.str.len = 0;
+    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. */
+    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;
+    register int cleanup;
+    Tcl_Obj *objResultPtr;
+    char *part1, *part2;
+    Var *varPtr, *arrayPtr;
+    CallFrame *varFramePtr = iPtr->varFramePtr;
 
-#ifdef TCL_COMPILE_STATS
-    iPtr->stats.numExecutions++;
+#ifdef TCL_TIP280
+    /* TIP #280 : Structures for tracking lines */
+    CmdFrame bcFrame;
 #endif
 
-    /*
-     * Push the callback for bytecode execution
-     */
-
-    TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0),
-	    NULL, NULL);
-    return TCL_OK;
-}
-
-static int
-TEBCresume(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    /*
-     * 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)
-#define UnsetTraced(varPtr) ((varPtr)->flags & VAR_TRACED_UNSET)
-
-    /*
-     * Bottom of allocated stack holds the NR data
-     */
-
-    /*
-     * Constants: variables that do not change during the execution, used
-     * sporadically: no special need for speed.
-     */
-
-    int instructionCount = 0;	/* Counter that is used to work out when to
-				 * call Tcl_AsyncReady() */
-    const char *curInstName;
 #ifdef TCL_COMPILE_DEBUG
-    int traceInstructions;	/* Whether we are doing instruction-level
-				 * tracing or not. */
+    int traceInstructions = (tclTraceExec == 3);
+    char cmdNameBuf[21];
 #endif
-
-    Var *compiledLocals = iPtr->varFramePtr->compiledLocals;
-    Tcl_Obj **constants = &iPtr->execEnvPtr->constants[0];
-
-#define LOCAL(i)	(&compiledLocals[(i)])
-#define TCONST(i)	(constants[(i)])
+    char *curInstName = NULL;
 
     /*
-     * These macros are just meant to save some global variables that are not
-     * used too frequently
+     * 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.
      */
 
-    TEBCdata *TD = data[0];
-#define auxObjList	(TD->auxObjList)
-#define catchTop	(TD->catchTop)
-#define codePtr		(TD->codePtr)
-#define checkInterp	(TD->checkInterp)
-			/* Indicates when a check of interp readyness is
-			 * necessary. Set by CACHE_STACK_INFO() */
-
-    /*
-     * Globals: variables that store state, must remain valid at all times.
-     */
-
-    Tcl_Obj **tosPtr;		/* Cached pointer to top of evaluation
-				 * stack. */
-    const unsigned char *pc;	/* The current program counter. */
-
-    /*
-     * Transfer variables - needed only between opcodes, but not while
-     * executing an instruction.
-     */
-
-    int cleanup = 0;
-    Tcl_Obj *objResultPtr;
-
-    /*
-     * Locals - variables that are used within opcodes or bounded sections of
-     * the file (jumps between opcodes within a family).
-     * NOTE: These are now mostly defined locally where needed.
-     */
-
-    Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr;
-    Tcl_Obj **objv;
-    int objc = 0;
-    int opnd, length, pcAdjustment;
-    Var *varPtr, *arrayPtr;
-#ifdef TCL_COMPILE_DEBUG
-    char cmdNameBuf[21];
+#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
 
 #ifdef TCL_COMPILE_DEBUG
-    traceInstructions = (tclTraceExec == 3);
-#endif
-
-    TEBC_DATA_DIG();
-
-#ifdef TCL_COMPILE_DEBUG
-    if (!data[1] && (tclTraceExec >= 2)) {
+    if (tclTraceExec >= 2) {
 	PrintByteCodeInfo(codePtr);
-	fprintf(stdout, "  Starting stack top=%d\n", (int) CURR_DEPTH);
+	fprintf(stdout, "  Starting stack top=%d\n", eePtr->stackTop);
 	fflush(stdout);
     }
+    opnd = 0;			/* Init. avoids compiler warning. */       
 #endif
-
-    if (data[1] /* resume from invocation */) {
-	if (iPtr->execEnvPtr->rewind) {
-	    result = TCL_ERROR;
-	}
-	NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr);
-	iPtr->cmdFramePtr = bcFramePtr->nextPtr;
-	if (iPtr->flags & INTERP_DEBUG_FRAME) {
-	    TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr);
-	}
-	if (codePtr->flags & TCL_BYTECODE_RECOMPILE) {
-	    iPtr->flags |= ERR_ALREADY_LOGGED;
-	    codePtr->flags &= ~TCL_BYTECODE_RECOMPILE;
-	}
-
-	CACHE_STACK_INFO();
-	if (result == TCL_OK) {
-#ifndef TCL_COMPILE_DEBUG
-	    if (*pc == INST_POP) {
-		NEXT_INST_V(1, cleanup, 0);
-	    }
+    
+#ifdef TCL_COMPILE_STATS
+    iPtr->stats.numExecutions++;
 #endif
-	    /*
-	     * 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));
-
-	    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.
-	     *
-	     * Note that the result object is now in objResultPtr, it keeps
-	     * the refCount it had in its role of iPtr->objResultPtr.
-	     */
 
-	    TclNewObj(objPtr);
-	    Tcl_IncrRefCount(objPtr);
-	    iPtr->objResultPtr = objPtr;
-	    NEXT_INST_V(0, cleanup, -1);
-	}
+    /*
+     * 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.
+     */
 
-	/*
-	 * Result not TCL_OK: fall through
-	 */
+    if (codePtr->maxExceptDepth > STATIC_CATCH_STACK_SIZE) {
+	catchStackPtr = (int *)
+	        ckalloc(codePtr->maxExceptDepth * sizeof(int));
     }
 
-    if (iPtr->execEnvPtr->rewind) {
-	result = TCL_ERROR;
-	goto abnormalReturn;
-    }
+    /*
+     * Make sure the stack has enough room to execute this ByteCode.
+     */
 
-    if (result != TCL_OK) {
-	pc--;
-	goto processExceptionReturn;
+    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.
      */
-
-  cleanupV_pushObjResultPtr:
+    
+    cleanupV_pushObjResultPtr:
     switch (cleanup) {
-    case 0:
-	*(++tosPtr) = (objResultPtr);
-	goto cleanup0;
-    default:
-	cleanup -= 2;
-	while (cleanup--) {
-	    objPtr = POP_OBJECT();
-	    TclDecrRefCount(objPtr);
-	}
-    case 2:
-    cleanup2_pushObjResultPtr:
-	objPtr = POP_OBJECT();
-	TclDecrRefCount(objPtr);
-    case 1:
-    cleanup1_pushObjResultPtr:
-	objPtr = OBJ_AT_TOS;
-	TclDecrRefCount(objPtr);
+        case 0:
+	    stackPtr[++stackTop] = (objResultPtr);
+	    goto cleanup0;
+        default:
+	    cleanup -= 2;
+	    while (cleanup--) {
+		valuePtr = POP_OBJECT();
+		TclDecrRefCount(valuePtr);
+	    }
+        case 2: 
+        cleanup2_pushObjResultPtr:
+	    valuePtr = POP_OBJECT();
+	    TclDecrRefCount(valuePtr);
+        case 1: 
+        cleanup1_pushObjResultPtr:
+	    valuePtr = stackPtr[stackTop];
+	    TclDecrRefCount(valuePtr);
     }
-    OBJ_AT_TOS = objResultPtr;
+    stackPtr[stackTop] = objResultPtr;
     goto cleanup0;
-
-  cleanupV:
+    
+    cleanupV:
     switch (cleanup) {
-    default:
-	cleanup -= 2;
-	while (cleanup--) {
-	    objPtr = POP_OBJECT();
-	    TclDecrRefCount(objPtr);
-	}
-    case 2:
-    cleanup2:
-	objPtr = POP_OBJECT();
-	TclDecrRefCount(objPtr);
-    case 1:
-    cleanup1:
-	objPtr = POP_OBJECT();
-	TclDecrRefCount(objPtr);
-    case 0:
-	/*
-	 * We really want to do nothing now, but this is needed for some
-	 * compilers (SunPro CC).
-	 */
-
-	break;
+        default:
+	    cleanup -= 2;
+	    while (cleanup--) {
+		valuePtr = POP_OBJECT();
+		TclDecrRefCount(valuePtr);
+	    }
+        case 2: 
+        cleanup2:
+	    valuePtr = POP_OBJECT();
+	    TclDecrRefCount(valuePtr);
+        case 1: 
+        cleanup1:
+	    valuePtr = POP_OBJECT();
+	    TclDecrRefCount(valuePtr);
+        case 0:
+	    /*
+	     * We really want to do nothing now, but this is needed
+	     * for some compilers (SunPro CC)
+	     */
+	    break;
     }
-  cleanup0:
 
+    cleanup0:
+    
 #ifdef TCL_COMPILE_DEBUG
-    /*
-     * Skip the stack depth check if an expansion is in progress.
-     */
-
-    ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, 0,
-	    /*checkStack*/ auxObjList == NULL);
+    ValidatePcAndStackTop(codePtr, pc, stackTop, initStackTop);
     if (traceInstructions) {
-	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, (int) CURR_DEPTH);
+	fprintf(stdout, "%2d: %2d ", iPtr->numLevels, stackTop);
 	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) {
-	DECACHE_STACK_INFO();
-	if (TclAsyncReady(iPtr)) {
-	    result = Tcl_AsyncInvoke(interp, result);
-	    if (result == TCL_ERROR) {
-		CACHE_STACK_INFO();
-		goto gotError;
-	    }
-	}
-
-	if (TclCanceled(iPtr)) {
-	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
-		CACHE_STACK_INFO();
-		goto gotError;
-	    }
-	}
-
-	if (TclLimitReady(iPtr->limit)) {
-	    if (Tcl_LimitCheck(interp) == TCL_ERROR) {
-		CACHE_STACK_INFO();
-		goto gotError;
-	    }
-	}
-	CACHE_STACK_INFO();
-    }
-
-    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;
-    }
+     TCL_DTRACE_INST_NEXT();
 
     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);
-	}
-	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);
-	}
-	Tcl_SetObjResult(interp, objResultPtr);
-	cleanup = 1;
-	goto processExceptionReturn;
-
     case INST_DONE:
-	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;
+	if (stackTop <= initStackTop) {
+	    stackTop--;
+	    goto abnormalReturn;
 	}
-	(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
+	
 	/*
-	 * Runtime peephole optimisation: check if we are pushing again.
+	 * 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".
 	 */
 
-	if (*pc == INST_PUSH1) {
-	    TCL_DTRACE_INST_NEXT();
-	    goto instPush1Peephole;
+	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");
 	}
 #endif
-	NEXT_INST_F(0, 0, 0);
+	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);
 
     case INST_PUSH4:
 	objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)];
@@ -2376,528 +1395,343 @@ TEBCresume(
 	NEXT_INST_F(5, 0, 1);
 
     case INST_POP:
-	TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS);
-	objPtr = POP_OBJECT();
-	TclDecrRefCount(objPtr);
-
-	/*
-	 * 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) {
-	    goto instStartCmdOK;
-	} else if (((codePtr->compileEpoch == iPtr->compileEpoch)
-		&& (codePtr->nsEpoch == iPtr->varFramePtr->nsPtr->resolverEpoch))
-		|| (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
-	    checkInterp = 0;
-	instStartCmdOK:
-	    NEXT_INST_F(9, 0, 0);
-	} else {
-	    const char *bytes;
-
-	    length = 0;
-
-	    /*
-	     * We used to switch to direct eval; for NRE-awareness we now
-	     * compile and eval the command so that this evaluation does not
-	     * add a new TEBC instance. [Bug 2910748]
-	     */
-
-	    if (TclInterpReady(interp) == TCL_ERROR) {
-		goto gotError;
-	    }
-
-	    codePtr->flags |= TCL_BYTECODE_RECOMPILE;
-	    bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
-	    opnd = TclGetUInt4AtPtr(pc+1);
-	    pc += (opnd-1);
-	    PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
-	    goto instEvalStk;
-	}
-
-    case INST_NOP:
-	pc += 1;
-	goto cleanup0;
-
+	TRACE_WITH_OBJ(("=> discarding "), stackPtr[stackTop]);
+	valuePtr = POP_OBJECT();
+	TclDecrRefCount(valuePtr);
+	NEXT_INST_F(1, 0, 0);
+	
     case INST_DUP:
-	objResultPtr = OBJ_AT_TOS;
+	objResultPtr = stackPtr[stackTop];
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(1, 0, 1);
 
     case INST_OVER:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	objResultPtr = OBJ_AT_DEPTH(opnd);
+	opnd = TclGetUInt4AtPtr( pc+1 );
+	objResultPtr = stackPtr[ stackTop - opnd ];
 	TRACE_WITH_OBJ(("=> "), objResultPtr);
 	NEXT_INST_F(5, 0, 1);
 
-    case INST_REVERSE: {
-	Tcl_Obj **a, **b;
-
-	opnd = TclGetUInt4AtPtr(pc+1);
-	a = tosPtr-(opnd-1);
-	b = tosPtr;
-	while (a<b) {
-	    tmpPtr = *a;
-	    *a = *b;
-	    *b = tmpPtr;
-	    a++; b--;
-	}
-	NEXT_INST_F(5, 0, 0);
-    }
-
-    case INST_CONCAT1: {
-	int appendLen = 0;
-	char *bytes, *p;
-	Tcl_Obj **currPtr;
-	int onlyb = 1;
-
+    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]).
+	     */
 
-	/*
-	 * Detect only-bytearray-or-null case.
-	 */
-
-	for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) {
-	    if (((*currPtr)->typePtr != &tclByteArrayType)
-		    && ((*currPtr)->bytes != tclEmptyStringRep)) {
-		onlyb = 0;
-		break;
-	    } else if (((*currPtr)->typePtr == &tclByteArrayType) &&
-		    ((*currPtr)->bytes != NULL)) {
-		onlyb = 0;
-		break;
-	    }
-	}
-
-	/*
-	 * Compute the length to be appended.
-	 */
-
-	if (onlyb) {
-	    for (currPtr = &OBJ_AT_DEPTH(opnd-2);
-		    appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
-		if ((*currPtr)->bytes != tclEmptyStringRep) {
-		    Tcl_GetByteArrayFromObj(*currPtr, &length);
-		    appendLen += length;
-		}
-	    }
-	} else {
-	    for (currPtr = &OBJ_AT_DEPTH(opnd-2);
-		    appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
-		bytes = TclGetStringFromObj(*currPtr, &length);
-		if (bytes != NULL) {
-		    appendLen += length;
+	    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);
 		}
 	    }
-	}
-
-	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);
-	if (!onlyb) {
-	    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->bytes = ckrealloc(bytes, length+appendLen+1);
-		objResultPtr->length = length + appendLen;
-		p = TclGetString(objResultPtr) + length;
-		currPtr = &OBJ_AT_DEPTH(opnd - 2);
-	    } else
-#endif
-	    {
-		p = ckalloc(length + appendLen + 1);
-		TclNewObj(objResultPtr);
-		objResultPtr->bytes = p;
-		objResultPtr->length = length + appendLen;
-		currPtr = &OBJ_AT_DEPTH(opnd - 1);
-	    }
 
 	    /*
-	     * Append the remaining characters.
+	     * 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.
 	     */
 
-	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
-		bytes = TclGetStringFromObj(*currPtr, &length);
+	    for (i = (stackTop - (opnd-1));
+		    totalLen >= 0 && i <= stackTop; i++) {
+		bytes = Tcl_GetStringFromObj(stackPtr[i], &length);
 		if (bytes != NULL) {
-		    memcpy(p, bytes, (size_t) length);
-		    p += length;
+		    totalLen += length;
 		}
 	    }
-	    *p = '\0';
-	} else {
-	    bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
-	    if (length + appendLen < 0) {
-		/* TODO: convert panic to error ? */
+
+	    if (totalLen < 0) {
 		Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
 			INT_MAX);
 	    }
-#if !TCL_COMPILE_DEBUG
-	    if (!Tcl_IsShared(objResultPtr)) {
-		bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
-			length + appendLen);
-		p = bytes + length;
-		currPtr = &OBJ_AT_DEPTH(opnd - 2);
-	    } else
-#endif
-	    {
-		TclNewObj(objResultPtr);
-		bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
-			length + appendLen);
-		p = bytes;
-		currPtr = &OBJ_AT_DEPTH(opnd - 1);
-	    }
 
 	    /*
-	     * Append the remaining characters.
+	     * Initialize the new append string object by appending the
+	     * strings of the opnd stack objects. Also pop the objects. 
 	     */
 
-	    for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
-		if ((*currPtr)->bytes != tclEmptyStringRep) {
-		    bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
-		    memcpy(p, bytes, (size_t) length);
-		    p += length;
+	    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);
 	}
+	    
+    case INST_INVOKE_STK4:
+	opnd = TclGetUInt4AtPtr(pc+1);
+	pcAdjustment = 5;
+	goto doInvocation;
 
-	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
-	NEXT_INST_V(2, opnd, 1);
-    }
-
-    case INST_EXPAND_START:
-	/*
-	 * Push an element to the auxObjList. 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).
-	 */
-
-	TclNewObj(objPtr);
-	objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH;
-	PUSH_TAUX_OBJ(objPtr);
-	NEXT_INST_F(1, 0, 0);
-
-    case INST_EXPAND_STKTOP: {
-	int i;
-	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.
-	 */
-
-	objPtr = OBJ_AT_TOS;
-	if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)),
-		    Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
-	(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.
-	 */
+    case INST_INVOKE_STK1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	pcAdjustment = 2;
+	    
+    doInvocation:
+	{
+	    int objc = opnd; /* The number of arguments. */
+	    Tcl_Obj **objv;	 /* The array of argument objects. */
 
-	length = objc + (codePtr->maxStackDepth - TclGetInt4AtPtr(pc+1));
-	DECACHE_STACK_INFO();
-	moved = GrowEvaluationStack(iPtr->execEnvPtr, length, 1)
-		- (Tcl_Obj **) TD;
-	if (moved) {
 	    /*
-	     * Change the global data to point to the new stack: move the
-	     * TEBCdataPtr TD, recompute the position of every other
-	     * stack-allocated parameter, update the stack pointers.
+	     * We keep the stack reference count as a (char *), as that
+	     * works nicely as a portable pointer-sized counter.
 	     */
 
-	    esPtr = iPtr->execEnvPtr->execStackPtr;
-	    TD = (TEBCdata *) (((Tcl_Obj **)TD) + moved);
+	    char **preservedStackRefCountPtr;
+	    
+	    /* 
+	     * Reference to memory block containing
+	     * objv array (must be kept live throughout
+	     * trace and command invokations.) 
+	     */
 
-	    catchTop += moved;
-	    tosPtr += moved;
-	}
+	    objv = &(stackPtr[stackTop - (objc-1)]);
 
-	/*
-	 * Expand the list at stacktop onto the stack; free the list. Knowing
-	 * that it has a freeIntRepProc we use Tcl_DecrRefCount().
-	 */
+#ifdef TCL_COMPILE_DEBUG
+	    if (tclTraceExec >= 2) {
+		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));
+		}
+		for (i = 0;  i < objc;  i++) {
+		    TclPrintObject(stdout, objv[i], 15);
+		    fprintf(stdout, " ");
+		}
+		fprintf(stdout, "\n");
+		fflush(stdout);
+	    }
+#endif /*TCL_COMPILE_DEBUG*/
 
-	for (i = 0; i < objc; i++) {
-	    PUSH_OBJECT(objv[i]);
-	}
+	    /* 
+	     * 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.
+	     */
 
-	Tcl_DecrRefCount(objPtr);
-	NEXT_INST_F(5, 0, 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
+			 */
 
-    case INST_EXPR_STK: {
-	ByteCode *newCodePtr;
+			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);
+		}
+	    }		
 
-	bcFramePtr->data.tebc.pc = (char *) pc;
-	iPtr->cmdFramePtr = bcFramePtr;
-	DECACHE_STACK_INFO();
-	newCodePtr = CompileExprObj(interp, OBJ_AT_TOS);
-	CACHE_STACK_INFO();
-	cleanup = 1;
-	pc++;
-	TEBC_YIELD();
-	return TclNRExecuteByteCode(interp, newCodePtr);
-    }
+	    /*
+	     * 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.
+	     */
 
-	/*
-	 * INVOCATION BLOCK
-	 */
+	    preservedStackRefCountPtr = (char **) (stackPtr-1);
+	    ++*preservedStackRefCountPtr;
 
-    instEvalStk:
-    case INST_EVAL_STK:
-	bcFramePtr->data.tebc.pc = (char *) pc;
-	iPtr->cmdFramePtr = bcFramePtr;
+	    /*
+	     * Finally, let TclEvalObjvInternal handle the command.
+	     *
+	     * TIP #280 : Record the last piece of info needed by
+	     * 'TclGetSrcInfoForPc', and push the frame.
+	     */
 
-	cleanup = 1;
-	pc += 1;
-	TEBC_YIELD();
-	return TclNREvalObjEx(interp, OBJ_AT_TOS, 0, NULL, 0);
-
-    case INST_INVOKE_EXPANDED:
-	CLANG_ASSERT(auxObjList);
-	objc = CURR_DEPTH - auxObjList->internalRep.ptrAndLongRep.value;
-	POP_TAUX_OBJ();
-	if (objc) {
-	    pcAdjustment = 1;
-	    goto doInvocation;
-	}
+#ifdef TCL_TIP280
+	    bcFrame.data.tebc.pc = (char*) pc;
+	    iPtr->cmdFramePtr = &bcFrame;
+	    TclArgumentBCEnter((Tcl_Interp*) iPtr, objv, objc,
+			       codePtr, &bcFrame,
+			       pc - codePtr->codeStart);
+#endif
+	    DECACHE_STACK_INFO();
+	    Tcl_ResetResult(interp);
+	    result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
+	    CACHE_STACK_INFO();
+#ifdef TCL_TIP280
+	    TclArgumentBCRelease((Tcl_Interp*) iPtr,  objv, objc,
+				 codePtr,
+				 pc - codePtr->codeStart);
+	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+#endif
 
-	/*
-	 * Nothing was expanded, return {}.
-	 */
+	    /*
+	     * 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.
+	     */
 
-	TclNewObj(objResultPtr);
-	NEXT_INST_F(1, 0, 1);
+	    --*preservedStackRefCountPtr;
+	    if (*preservedStackRefCountPtr == (char *) 0) {
+		ckfree((VOID *) preservedStackRefCountPtr);
+	    }	    
 
-    case INST_INVOKE_STK4:
-	objc = TclGetUInt4AtPtr(pc+1);
-	pcAdjustment = 5;
-	goto doInvocation;
+	    if (result == TCL_OK) {
+		/*
+		 * Push the call's object result and continue execution
+		 * with the next instruction.
+		 */
 
-    case INST_INVOKE_STK1:
-	objc = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;
+		TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=",
+		        objc, cmdNameBuf), Tcl_GetObjResult(interp));
 
-    doInvocation:
-	objv = &OBJ_AT_DEPTH(objc-1);
-	cleanup = objc;
+		objResultPtr = Tcl_GetObjResult(interp);
 
-#ifdef TCL_COMPILE_DEBUG
-	if (tclTraceExec >= 2) {
-	    int i;
+		/*
+		 * 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.
+		 */
+		{
+		    Tcl_Obj *newObjResultPtr;
+		    TclNewObj(newObjResultPtr);
+		    Tcl_IncrRefCount(newObjResultPtr);
+		    iPtr->objResultPtr = newObjResultPtr;
+		}
 
-	    if (traceInstructions) {
-		strncpy(cmdNameBuf, TclGetString(objv[0]), 20);
-		TRACE(("%u => call ", objc));
+		NEXT_INST_V(pcAdjustment, opnd, -1);
 	    } else {
-		fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels,
-			(unsigned)(pc - codePtr->codeStart));
+		cleanup = opnd;
+		goto processExceptionReturn;
 	    }
-	    for (i = 0;  i < objc;  i++) {
-		TclPrintObject(stdout, objv[i], 15);
-		fprintf(stdout, " ");
-	    }
-	    fprintf(stdout, "\n");
-	    fflush(stdout);
 	}
-#endif /*TCL_COMPILE_DEBUG*/
 
+    case INST_EVAL_STK:
 	/*
-	 * Finally, let TclEvalObjv handle the command.
-	 *
-	 * TIP #280: Record the last piece of info needed by
-	 * 'TclGetSrcInfoForPc', and push the frame.
+	 * Note to maintainers: it is important that INST_EVAL_STK
+	 * pop its argument from the stack before jumping to
+	 * checkForCatch! DO NOT OPTIMISE!
 	 */
 
-	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);
-	}
-
+	objPtr = stackPtr[stackTop];
 	DECACHE_STACK_INFO();
-
-	pc += pcAdjustment;
-	TEBC_YIELD();
-	return TclNREvalObjv(interp, objc, objv,
-		TCL_EVAL_NOERR, NULL);
-
-#if TCL_SUPPORT_84_BYTECODE
-    case INST_CALL_BUILTIN_FUNC1:
-	/*
-	 * 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.
+#ifndef TCL_TIP280
+	result = TclCompEvalObj(interp, objPtr);
+#else
+	/* TIP #280: The invoking context is left NULL for a dynamically
+	 * constructed command. We cannot match its lines to the outer
+	 * context.
 	 */
 
-	opnd = TclGetUInt1AtPtr(pc+1);
-	if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
-	    TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
-	    Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
-	}
-
-	TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
-	Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
+	result = TclCompEvalObj(interp, objPtr, NULL,0);
+#endif
+	CACHE_STACK_INFO();
+	if (result == TCL_OK) {
+	    /*
+	     * Normal return; push the eval's object result.
+	     */
 
-	/*
-	 * Only 0, 1 or 2 args.
-	 */
+	    objResultPtr = Tcl_GetObjResult(interp);
+	    TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(objPtr)),
+			   Tcl_GetObjResult(interp));
 
-	{
-	    int numArgs = tclBuiltinFuncTable[opnd].numArgs;
-	    Tcl_Obj *tmpPtr1, *tmpPtr2;
-
-	    if (numArgs == 0) {
-		PUSH_OBJECT(objPtr);
-	    } else if (numArgs == 1) {
-		tmpPtr1 = POP_OBJECT();
-		PUSH_OBJECT(objPtr);
-		PUSH_OBJECT(tmpPtr1);
-		Tcl_DecrRefCount(tmpPtr1);
-	    } else {
-		tmpPtr2 = POP_OBJECT();
-		tmpPtr1 = POP_OBJECT();
-		PUSH_OBJECT(objPtr);
-		PUSH_OBJECT(tmpPtr1);
-		PUSH_OBJECT(tmpPtr2);
-		Tcl_DecrRefCount(tmpPtr1);
-		Tcl_DecrRefCount(tmpPtr2);
+	    /*
+	     * 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.
+	     */
+	    {
+	        Tcl_Obj *newObjResultPtr;
+		TclNewObj(newObjResultPtr);
+		Tcl_IncrRefCount(newObjResultPtr);
+		iPtr->objResultPtr = newObjResultPtr;
 	    }
-	    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].
-	 */
-
-	objc = TclGetUInt1AtPtr(pc+1);	/* Number of arguments. The function
-					 * name is the 0-th argument. */
-
-	objPtr = OBJ_AT_DEPTH(objc-1);
-	TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
-	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
-    /*
-     * 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.
-     */
+	    NEXT_INST_F(1, 1, -1);
+	} else {
+	    cleanup = 1;
+	    goto processExceptionReturn;
+	}
 
-    case INST_CALL_BUILTIN_FUNC1:
-	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
-    case INST_CALL_FUNC1:
-	Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
-#endif
+    case INST_EXPR_STK:
+	objPtr = stackPtr[stackTop];
+	DECACHE_STACK_INFO();
+	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));
+	    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 some
-     * 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.
      */
 
     case INST_LOAD_SCALAR1:
-    instLoadScalar1:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	varPtr = LOCAL(opnd);
+	varPtr = &(varFramePtr->compiledLocals[opnd]);
+	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	TRACE(("%u => ", opnd));
-	if (TclIsVarDirectReadable(varPtr)) {
+	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
+	        && (varPtr->tracePtr == NULL)) {
 	    /*
 	     * No errors, no traces: just get the value.
 	     */
-
 	    objResultPtr = varPtr->value.objPtr;
 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	    NEXT_INST_F(2, 0, 1);
@@ -2905,21 +1739,22 @@ TEBCresume(
 	pcAdjustment = 2;
 	cleanup = 0;
 	arrayPtr = NULL;
-	part1Ptr = part2Ptr = NULL;
+	part2 = NULL;
 	goto doCallPtrGetVar;
 
     case INST_LOAD_SCALAR4:
 	opnd = TclGetUInt4AtPtr(pc+1);
-	varPtr = LOCAL(opnd);
+	varPtr = &(varFramePtr->compiledLocals[opnd]);
+	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	TRACE(("%u => ", opnd));
-	if (TclIsVarDirectReadable(varPtr)) {
+	if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr) 
+	        && (varPtr->tracePtr == NULL)) {
 	    /*
 	     * No errors, no traces: just get the value.
 	     */
-
 	    objResultPtr = varPtr->value.objPtr;
 	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	    NEXT_INST_F(5, 0, 1);
@@ -2927,263 +1762,193 @@ TEBCresume(
 	pcAdjustment = 5;
 	cleanup = 0;
 	arrayPtr = NULL;
-	part1Ptr = part2Ptr = NULL;
-	goto doCallPtrGetVar;
-
-    case INST_LOAD_ARRAY4:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	pcAdjustment = 5;
-	goto doLoadArray;
-
-    case INST_LOAD_ARRAY1:
-	opnd = TclGetUInt1AtPtr(pc+1);
-	pcAdjustment = 2;
-
-    doLoadArray:
-	part1Ptr = NULL;
-	part2Ptr = OBJ_AT_TOS;
-	arrayPtr = LOCAL(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 && 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))));
-	    goto gotError;
-	}
-	cleanup = 1;
+	part2 = NULL;
 	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)));
+	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;
-	part2Ptr = NULL;
-	objPtr = OBJ_AT_TOS;		/* variable name */
+	part2 = NULL;
+	objPtr = stackPtr[stackTop]; /* 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) {
+	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))));
-	    goto gotError;
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-
-	if (TclIsVarDirectReadable2(varPtr, arrayPtr)) {
+	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;
-	opnd = -1;
-
-    doCallPtrGetVar:
-	/*
-	 * There are either errors or the variable is traced: call
-	 * TclPtrGetVar to process fully.
-	 */
-
-	DECACHE_STACK_INFO();
-	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr,
-		part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd);
-	CACHE_STACK_INFO();
-	if (!objResultPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    goto gotError;
-	}
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_V(pcAdjustment, cleanup, 1);
-
-    /*
-     *	   End of INST_LOAD 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.
-     */
-
-    {
-	int storeFlags;
+	goto doCallPtrGetVar;
 
-    case INST_STORE_ARRAY4:
+    case INST_LOAD_ARRAY4:
 	opnd = TclGetUInt4AtPtr(pc+1);
 	pcAdjustment = 5;
-	goto doStoreArrayDirect;
+	goto doLoadArray;
 
-    case INST_STORE_ARRAY1:
+    case INST_LOAD_ARRAY1:
 	opnd = TclGetUInt1AtPtr(pc+1);
 	pcAdjustment = 2;
-
-    doStoreArrayDirect:
-	valuePtr = OBJ_AT_TOS;
-	part2Ptr = OBJ_UNDER_TOS;
-	arrayPtr = LOCAL(opnd);
-	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
-		O2S(valuePtr)));
+    
+    doLoadArray:
+	part2 = TclGetString(stackPtr[stackTop]);
+	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
+	part1 = arrayPtr->name;
 	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 = LOCAL(opnd);
-	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
-	while (TclIsVarLink(varPtr)) {
-	    varPtr = varPtr->value.linkPtr;
+	TRACE(("%u \"%.30s\" => ", opnd, part2));
+	varPtr = TclLookupArrayElement(interp, part1, part2, 
+	        TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
+	if (varPtr == NULL) {
+	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-	if (!TclIsVarDirectWritable(varPtr)) {
-	    storeFlags = TCL_LEAVE_ERR_MSG;
-	    part1Ptr = NULL;
-	    goto doStoreScalar;
+	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;
 
+    doCallPtrGetVar:
 	/*
-	 * 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.
+	 * There are either errors or the variable is traced:
+	 * call TclPtrGetVar to process fully.
 	 */
 
-    doStoreVarDirect:
-	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);
+	DECACHE_STACK_INFO();
+	objResultPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, 
+	        part2, TCL_LEAVE_ERR_MSG);
+	CACHE_STACK_INFO();
+	if (objResultPtr == NULL) {
+	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-#else
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-#endif
-	Tcl_IncrRefCount(objResultPtr);
-	NEXT_INST_F(pcAdjustment, 0, 0);
+	NEXT_INST_V(pcAdjustment, cleanup, 1);
+
+    /*
+     *     End of INST_LOAD 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.
+     */
 
     case INST_LAPPEND_STK:
-	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2Ptr = NULL;
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
-		| TCL_LIST_ELEMENT);
+	valuePtr = stackPtr[stackTop]; /* value to append */
+	part2 = NULL;
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
+		      | TCL_LIST_ELEMENT);
 	goto doStoreStk;
 
     case INST_LAPPEND_ARRAY_STK:
-	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2Ptr = OBJ_UNDER_TOS;
-	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE
-		| TCL_LIST_ELEMENT);
+	valuePtr = stackPtr[stackTop]; /* value to append */
+	part2 = TclGetString(stackPtr[stackTop - 1]);
+	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE 
+		      | TCL_LIST_ELEMENT);
 	goto doStoreStk;
 
     case INST_APPEND_STK:
-	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2Ptr = NULL;
+	valuePtr = stackPtr[stackTop]; /* value to append */
+	part2 = NULL;
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreStk;
 
     case INST_APPEND_ARRAY_STK:
-	valuePtr = OBJ_AT_TOS; /* value to append */
-	part2Ptr = OBJ_UNDER_TOS;
+	valuePtr = stackPtr[stackTop]; /* value to append */
+	part2 = TclGetString(stackPtr[stackTop - 1]);
 	storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE);
 	goto doStoreStk;
 
     case INST_STORE_ARRAY_STK:
-	valuePtr = OBJ_AT_TOS;
-	part2Ptr = OBJ_UNDER_TOS;
+	valuePtr = stackPtr[stackTop];
+	part2 = TclGetString(stackPtr[stackTop - 1]);
 	storeFlags = TCL_LEAVE_ERR_MSG;
 	goto doStoreStk;
 
     case INST_STORE_STK:
     case INST_STORE_SCALAR_STK:
-	valuePtr = OBJ_AT_TOS;
-	part2Ptr = NULL;
+	valuePtr = stackPtr[stackTop];
+	part2 = NULL;
 	storeFlags = TCL_LEAVE_ERR_MSG;
 
     doStoreStk:
-	objPtr = OBJ_AT_DEPTH(1 + (part2Ptr != NULL)); /* variable name */
-	part1Ptr = objPtr;
+	objPtr = stackPtr[stackTop - 1 - (part2 != NULL)]; /* variable name */
+	part1 = TclGetString(objPtr);
 #ifdef TCL_COMPILE_DEBUG
-	if (part2Ptr == NULL) {
-	    TRACE(("\"%.30s\" <- \"%.30s\" =>", O2S(part1Ptr),O2S(valuePtr)));
+	if (part2 == NULL) {
+	    TRACE(("\"%.30s\" <- \"%.30s\" =>", 
+	            part1, O2S(valuePtr)));
 	} else {
 	    TRACE(("\"%.30s(%.30s)\" <- \"%.30s\" => ",
-		    O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr)));
+		    part1, part2, O2S(valuePtr)));
 	}
 #endif
-	varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG,
-		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-	if (!varPtr) {
+	varPtr = TclObjLookupVar(interp, objPtr, part2, 
+	         TCL_LEAVE_ERR_MSG, "set",
+                 /*createPart1*/ 1,
+	         /*createPart2*/ 1, &arrayPtr);
+	if (varPtr == NULL) {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    goto gotError;
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-	cleanup = ((part2Ptr == NULL)? 2 : 3);
+	cleanup = ((part2 == NULL)? 2 : 3);
 	pcAdjustment = 1;
-	opnd = -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:
@@ -3198,39 +1963,49 @@ TEBCresume(
 	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 = OBJ_AT_TOS;
-	part2Ptr = OBJ_UNDER_TOS;
-	arrayPtr = LOCAL(opnd);
-	TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr),
-		O2S(valuePtr)));
+	valuePtr = stackPtr[stackTop];
+	part2 = TclGetString(stackPtr[stackTop - 1]);
+	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
+	part1 = arrayPtr->name;
+	TRACE(("%u \"%.30s\" <- \"%.30s\" => ",
+		    opnd, part2, O2S(valuePtr)));
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	cleanup = 2;
-	part1Ptr = NULL;
-
-    doStoreArrayDirectFailed:
-	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
-		TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd);
-	if (!varPtr) {
+	varPtr = TclLookupArrayElement(interp, part1, part2, 
+	        TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr);
+	if (varPtr == NULL) {
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    goto gotError;
+	    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:
@@ -3241,29 +2016,77 @@ TEBCresume(
 
     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 = OBJ_AT_TOS;
-	varPtr = LOCAL(opnd);
+	valuePtr = stackPtr[stackTop];
+	varPtr = &(varFramePtr->compiledLocals[opnd]);
+	part1 = varPtr->name;
 	TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr)));
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	cleanup = 1;
 	arrayPtr = NULL;
-	part1Ptr = part2Ptr = NULL;
+	part2 = NULL;
 
     doCallPtrSetVar:
-	DECACHE_STACK_INFO();
-	objResultPtr = TclPtrSetVar(interp, varPtr, arrayPtr,
-		part1Ptr, part2Ptr, valuePtr, storeFlags, opnd);
-	CACHE_STACK_INFO();
-	if (!objResultPtr) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    goto gotError;
+	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);
+	    }
+#ifndef TCL_COMPILE_DEBUG
+	    if (*(pc+pcAdjustment) == INST_POP) {
+		NEXT_INST_V((pcAdjustment+1), cleanup, 0);
+	    }
+#else
+	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
+#endif
+	    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) {
@@ -3272,26 +2095,21 @@ TEBCresume(
 #endif
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_V(pcAdjustment, cleanup, 1);
-    }
+
 
     /*
-     *	   End of INST_STORE and related 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.
+     *     End of INST_STORE and related instructions.
+     * ---------------------------------------------------------
      */
 
-/*TODO: Consider more untangling here; merge with LOAD and STORE ? */
-
-    {
-	Tcl_Obj *incrPtr;
-#ifndef NO_WIDE_TYPE
-	Tcl_WideInt w;
-#endif
-	long increment;
+    /*
+     * ---------------------------------------------------------
+     *     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.
+     */
 
     case INST_INCR_SCALAR1:
     case INST_INCR_ARRAY1:
@@ -3299,240 +2117,147 @@ TEBCresume(
     case INST_INCR_SCALAR_STK:
     case INST_INCR_STK:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	incrPtr = POP_OBJECT();
+	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);
 	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:
-	increment = TclGetInt1AtPtr(pc+1);
-	incrPtr = Tcl_NewIntObj(increment);
-	Tcl_IncrRefCount(incrPtr);
+	i = TclGetInt1AtPtr(pc+1);
 	pcAdjustment = 2;
-
+	    
     doIncrStk:
-	if ((*pc == INST_INCR_ARRAY_STK_IMM)
-		|| (*pc == INST_INCR_ARRAY_STK)) {
-	    part2Ptr = OBJ_AT_TOS;
-	    objPtr = OBJ_UNDER_TOS;
+	if ((*pc == INST_INCR_ARRAY_STK_IMM) 
+	        || (*pc == INST_INCR_ARRAY_STK)) {
+	    part2 = TclGetString(stackPtr[stackTop]);
+	    objPtr = stackPtr[stackTop - 1];
 	    TRACE(("\"%.30s(%.30s)\" (by %ld) => ",
-		    O2S(objPtr), O2S(part2Ptr), increment));
+		    O2S(objPtr), part2, i));
 	} else {
-	    part2Ptr = NULL;
-	    objPtr = OBJ_AT_TOS;
-	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), increment));
+	    part2 = NULL;
+	    objPtr = stackPtr[stackTop];
+	    TRACE(("\"%.30s\" (by %ld) => ", O2S(objPtr), i));
 	}
-	part1Ptr = objPtr;
-	opnd = -1;
-	varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr,
-		TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr);
-	if (!varPtr) {
+	part1 = TclGetString(objPtr);
+
+	varPtr = TclObjLookupVar(interp, objPtr, part2, 
+	        TCL_LEAVE_ERR_MSG, "read", 0, 1, &arrayPtr);
+	if (varPtr == NULL) {
+	    DECACHE_STACK_INFO();
 	    Tcl_AddObjErrorInfo(interp,
-		    "\n    (reading value of variable to increment)", -1);
+	            "\n    (reading value of variable to increment)", -1);
+	    CACHE_STACK_INFO();
 	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    Tcl_DecrRefCount(incrPtr);
-	    goto gotError;
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-	cleanup = ((part2Ptr == NULL)? 1 : 2);
+	cleanup = ((part2 == NULL)? 1 : 2);
 	goto doIncrVar;
 
     case INST_INCR_ARRAY1_IMM:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	increment = TclGetInt1AtPtr(pc+2);
-	incrPtr = Tcl_NewIntObj(increment);
-	Tcl_IncrRefCount(incrPtr);
+	i = TclGetInt1AtPtr(pc+2);
 	pcAdjustment = 3;
 
     doIncrArray:
-	part1Ptr = NULL;
-	part2Ptr = OBJ_AT_TOS;
-	arrayPtr = LOCAL(opnd);
-	cleanup = 1;
+	part2 = TclGetString(stackPtr[stackTop]);
+	arrayPtr = &(varFramePtr->compiledLocals[opnd]);
+	part1 = arrayPtr->name;
 	while (TclIsVarLink(arrayPtr)) {
 	    arrayPtr = arrayPtr->value.linkPtr;
 	}
-	TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), increment));
-	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr,
-		TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd);
-	if (!varPtr) {
+	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_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    Tcl_DecrRefCount(incrPtr);
-	    goto gotError;
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
+	cleanup = 1;
 	goto doIncrVar;
 
     case INST_INCR_SCALAR1_IMM:
 	opnd = TclGetUInt1AtPtr(pc+1);
-	increment = TclGetInt1AtPtr(pc+2);
+	i = TclGetInt1AtPtr(pc+2);
 	pcAdjustment = 3;
-	cleanup = 0;
-	varPtr = LOCAL(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 + increment;
-
-		    /*
-		     * Overflow when (augend and sum have different sign) and
-		     * (augend and increment have the same sign). This is
-		     * encapsulated in the Overflowing macro.
-		     */
-
-		    if (!Overflowing(augend, increment, sum)) {
-			TRACE(("%u %ld => ", opnd, increment));
-			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, increment));
-		    if (Tcl_IsShared(objPtr)) {
-			objPtr->refCount--;	/* We know it's shared. */
-			objResultPtr = Tcl_NewWideIntObj(w+increment);
-			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+increment);
-		    }
-		    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 + increment;
-
-		    /*
-		     * Check for overflow.
-		     */
-
-		    if (!Overflowing(w, increment, sum)) {
-			TRACE(("%u %ld => ", opnd, increment));
-			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, increment);
-	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
-		Tcl_DecrRefCount(incrPtr);
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		goto gotError;
-	    }
-	    Tcl_DecrRefCount(incrPtr);
-	    goto doneIncr;
-	}
-
-	/*
-	 * All other cases, flow through to generic handling.
-	 */
-
-	TclNewLongObj(incrPtr, increment);
-	Tcl_IncrRefCount(incrPtr);
 
     doIncrScalar:
-	varPtr = LOCAL(opnd);
+	varPtr = &(varFramePtr->compiledLocals[opnd]);
+	part1 = varPtr->name;
 	while (TclIsVarLink(varPtr)) {
 	    varPtr = varPtr->value.linkPtr;
 	}
 	arrayPtr = NULL;
-	part1Ptr = part2Ptr = NULL;
+	part2 = NULL;
 	cleanup = 0;
-	TRACE(("%u %ld => ", opnd, increment));
+	TRACE(("%u %ld => ", opnd, i));
+
 
     doIncrVar:
-	if (TclIsVarDirectModifyable2(varPtr, arrayPtr)) {
-	    objPtr = varPtr->value.objPtr;
+	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 (Tcl_IsShared(objPtr)) {
-		objPtr->refCount--;	/* We know it's shared */
-		objResultPtr = Tcl_DuplicateObj(objPtr);
+		objResultPtr = Tcl_NewLongObj(i);
+		TclDecrRefCount(objPtr);
 		Tcl_IncrRefCount(objResultPtr);
 		varPtr->value.objPtr = objResultPtr;
 	    } else {
+		Tcl_SetLongObj(objPtr, i);
 		objResultPtr = objPtr;
 	    }
-	    if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
-		Tcl_DecrRefCount(incrPtr);
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		goto gotError;
-	    }
-	    Tcl_DecrRefCount(incrPtr);
+	    TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	} else {
 	    DECACHE_STACK_INFO();
-	    objResultPtr = TclPtrIncrObjVar(interp, varPtr, arrayPtr,
-		    part1Ptr, part2Ptr, incrPtr, TCL_LEAVE_ERR_MSG, opnd);
+	    objResultPtr = TclPtrIncrVar(interp, varPtr, arrayPtr, part1, 
+                    part2, i, TCL_LEAVE_ERR_MSG);
 	    CACHE_STACK_INFO();
-	    Tcl_DecrRefCount(incrPtr);
 	    if (objResultPtr == NULL) {
-		TRACE_APPEND(("ERROR: %.30s\n",
-			O2S(Tcl_GetObjResult(interp))));
-		goto gotError;
+		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) {
@@ -3540,1277 +2265,895 @@ TEBCresume(
 	}
 #endif
 	NEXT_INST_V(pcAdjustment, cleanup, 1);
-    }
-
-    /*
-     *	   End of INST_INCR instructions.
-     * -----------------------------------------------------------------
-     *	   Start of INST_EXIST instructions.
-     */
-
-    case INST_EXIST_SCALAR:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	varPtr = LOCAL(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;
-	    }
-	}
-
-	/*
-	 * Tricky! Arrays always exist.
-	 */
-
-	objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_F(5, 0, 1);
-
-    case INST_EXIST_ARRAY:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	part2Ptr = OBJ_AT_TOS;
-	arrayPtr = LOCAL(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 = TCONST(!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 = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1);
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_V(1, cleanup, 1);
-
-    /*
-     *	   End of INST_EXIST instructions.
-     * -----------------------------------------------------------------
-     *	   Start of INST_UNSET instructions.
-     */
-
-    {
-	int flags;
-
-    case INST_UNSET_SCALAR:
-	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
-	opnd = TclGetUInt4AtPtr(pc+2);
-	varPtr = LOCAL(opnd);
-	while (TclIsVarLink(varPtr)) {
-	    varPtr = varPtr->value.linkPtr;
-	}
-	TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd));
-	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
-	    /*
-	     * No errors, no traces, no searches: just make the variable cease
-	     * to exist.
-	     */
-
-	    if (!TclIsVarUndefined(varPtr)) {
-		TclDecrRefCount(varPtr->value.objPtr);
-	    } else if (flags & TCL_LEAVE_ERR_MSG) {
-		goto slowUnsetScalar;
-	    }
-	    varPtr->value.objPtr = NULL;
-	    NEXT_INST_F(6, 0, 0);
-	}
-
-    slowUnsetScalar:
-	DECACHE_STACK_INFO();
-	if (TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, flags,
-		opnd) != TCL_OK && flags) {
-	    goto errorInUnset;
-	}
-	CACHE_STACK_INFO();
-	NEXT_INST_F(6, 0, 0);
-
-    case INST_UNSET_ARRAY:
-	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
-	opnd = TclGetUInt4AtPtr(pc+2);
-	part2Ptr = OBJ_AT_TOS;
-	arrayPtr = LOCAL(opnd);
-	while (TclIsVarLink(arrayPtr)) {
-	    arrayPtr = arrayPtr->value.linkPtr;
-	}
-	TRACE(("%s %u \"%.30s\"\n",
-		(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
-	if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
-	    varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
-	    if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
-		/*
-		 * No nasty traces and element exists, so we can proceed to
-		 * unset it. Might still not exist though...
-		 */
-
-		if (!TclIsVarUndefined(varPtr)) {
-		    TclDecrRefCount(varPtr->value.objPtr);
-		} else if (flags & TCL_LEAVE_ERR_MSG) {
-		    goto slowUnsetArray;
-		}
-		varPtr->value.objPtr = NULL;
-		NEXT_INST_F(6, 1, 0);
-	    } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) {
-		/*
-		 * Don't need to do anything here.
-		 */
-
-		NEXT_INST_F(6, 1, 0);
-	    }
-	}
-    slowUnsetArray:
-	DECACHE_STACK_INFO();
-	varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, flags, "unset",
-		0, 0, arrayPtr, opnd);
-	if (!varPtr) {
-	    if (flags & TCL_LEAVE_ERR_MSG) {
-		goto errorInUnset;
-	    }
-	} else if (TclPtrUnsetVar(interp, varPtr, arrayPtr, NULL, part2Ptr,
-		flags, opnd) != TCL_OK && (flags & TCL_LEAVE_ERR_MSG)) {
-	    goto errorInUnset;
-	}
-	CACHE_STACK_INFO();
-	NEXT_INST_F(6, 1, 0);
-
-    case INST_UNSET_ARRAY_STK:
-	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
-	cleanup = 2;
-	part2Ptr = OBJ_AT_TOS;		/* element name */
-	part1Ptr = OBJ_UNDER_TOS;	/* array name */
-	TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"),
-		O2S(part1Ptr), O2S(part2Ptr)));
-	goto doUnsetStk;
-
-    case INST_UNSET_STK:
-	flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0;
-	cleanup = 1;
-	part2Ptr = NULL;
-	part1Ptr = OBJ_AT_TOS;		/* variable name */
-	TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr)));
-
-    doUnsetStk:
-	DECACHE_STACK_INFO();
-	if (TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags) != TCL_OK
-		&& (flags & TCL_LEAVE_ERR_MSG)) {
-	    goto errorInUnset;
-	}
-	CACHE_STACK_INFO();
-	NEXT_INST_V(2, cleanup, 0);
-
-    errorInUnset:
-	CACHE_STACK_INFO();
-	TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	goto gotError;
-
-	/*
-	 * This is really an unset operation these days. Do not issue.
-	 */
-
-    case INST_DICT_DONE:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	TRACE(("%u\n", opnd));
-	varPtr = LOCAL(opnd);
-	while (TclIsVarLink(varPtr)) {
-	    varPtr = varPtr->value.linkPtr;
-	}
-	if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
-	    if (!TclIsVarUndefined(varPtr)) {
-		TclDecrRefCount(varPtr->value.objPtr);
-	    }
-	    varPtr->value.objPtr = NULL;
-	} else {
-	    DECACHE_STACK_INFO();
-	    TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd);
-	    CACHE_STACK_INFO();
-	}
-	NEXT_INST_F(5, 0, 0);
-    }
-
+	    	    
     /*
-     *	   End of INST_UNSET instructions.
-     * -----------------------------------------------------------------
-     *	   Start of variable linking instructions.
+     *     End of INST_INCR instructions.
+     * ---------------------------------------------------------
      */
 
-    {
-	Var *otherPtr;
-	CallFrame *framePtr, *savedFramePtr;
-	Tcl_Namespace *nsPtr;
-	Namespace *savedNsPtr;
-
-    case INST_UPVAR:
-	TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
-
-	if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) {
-	    goto gotError;
-	}
-
-	/*
-	 * 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) {
-	    goto gotError;
-	}
-	goto doLinkVars;
-
-    case INST_NSUPVAR:
-	TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
-	if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) {
-	    goto gotError;
-	}
-
-	/*
-	 * Locate the other variable.
-	 */
-
-	savedNsPtr = 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 = savedNsPtr;
-	if (!otherPtr) {
-	    goto gotError;
-	}
-	goto doLinkVars;
-
-    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) {
-	    goto gotError;
-	}
-
-	/*
-	 * Do the [variable] magic.
-	 */
-
-	TclSetVarNamespaceVar(otherPtr);
-
-    doLinkVars:
-
-	/*
-	 * 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.
-	 */
-
-	opnd = TclGetInt4AtPtr(pc+1);;
-	varPtr = LOCAL(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) {
-		    NEXT_INST_F(5, 1, 0);
-		}
-		if (TclIsVarInHash(linkPtr)) {
-		    VarHashRefCount(linkPtr)--;
-		    if (TclIsVarUndefined(linkPtr)) {
-			TclCleanupVar(linkPtr, NULL);
-		    }
-		}
-	    }
-	    TclSetVarLink(varPtr);
-	    varPtr->value.linkPtr = otherPtr;
-	    if (TclIsVarInHash(otherPtr)) {
-		VarHashRefCount(otherPtr)++;
-	    }
-	} else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0,
-		opnd) != TCL_OK) {
-	    goto gotError;
-	}
-
-	/*
-	 * Do not pop the namespace or frame index, it may be needed for other
-	 * variables - and [variable] did not push it at all.
-	 */
-
-	NEXT_INST_F(5, 1, 0);
-    }
-
-    /*
-     *	   End of variable linking instructions.
-     * -----------------------------------------------------------------
-     */
 
     case INST_JUMP1:
 	opnd = TclGetInt1AtPtr(pc+1);
 	TRACE(("%d => new pc %u\n", opnd,
-		(unsigned)(pc + opnd - codePtr->codeStart)));
+	        (unsigned int)(pc + opnd - codePtr->codeStart)));
 	NEXT_INST_F(opnd, 0, 0);
 
     case INST_JUMP4:
 	opnd = TclGetInt4AtPtr(pc+1);
 	TRACE(("%d => new pc %u\n", opnd,
-		(unsigned)(pc + opnd - codePtr->codeStart)));
+	        (unsigned int)(pc + opnd - codePtr->codeStart)));
 	NEXT_INST_F(opnd, 0, 0);
 
-    {
-	int jmpOffset[2], b;
-
-	/* 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;
+	opnd = 5;                             /* TRUE */
+	pcAdjustment = TclGetInt4AtPtr(pc+1); /* FALSE */
+	goto doJumpTrue;
 
     case INST_JUMP_TRUE4:
-	jmpOffset[0] = 5;
-	jmpOffset[1] = TclGetInt4AtPtr(pc+1);
-	goto doCondJump;
+	opnd = TclGetInt4AtPtr(pc+1);         /* TRUE */
+	pcAdjustment = 5;                     /* FALSE */
+	goto doJumpTrue;
 
     case INST_JUMP_FALSE1:
-	jmpOffset[0] = TclGetInt1AtPtr(pc+1);
-	jmpOffset[1] = 2;
-	goto doCondJump;
+	opnd = 2;                             /* TRUE */
+	pcAdjustment = TclGetInt1AtPtr(pc+1); /* FALSE */
+	goto doJumpTrue;
 
     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 */
-	if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[
-		    ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4))
-		    ? 0 : 1]), Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
-
-#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)));
+	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 {
-		TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr)));
+		result = Tcl_GetBooleanFromObj(interp, valuePtr, &b);
+		if (result != TCL_OK) {
+		    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+		    goto checkForCatch;
+		}
 	    }
-	} else {
-	    if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) {
-		TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr)));
+#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 {
-		TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0],
-			O2S(valuePtr),
-			(unsigned)(pc + jmpOffset[1] - codePtr->codeStart)));
+		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)));
+		}
+		NEXT_INST_F(pcAdjustment, 1, 0);
 	    }
-	}
 #endif
-	NEXT_INST_F(jmpOffset[b], 1, 0);
-    }
-
-    case INST_JUMP_TABLE: {
-	Tcl_HashEntry *hPtr;
-	JumptableInfo *jtPtr;
-
-	/*
-	 * 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: {
+    case INST_LAND:
+    {
 	/*
-	 * Operands must be boolean or numeric. No int->double conversions are
-	 * performed.
+	 * Operands must be boolean or numeric. No int->double
+	 * conversions are performed.
 	 */
-
-	int i1, i2, iResult;
-
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-	if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != 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 gotError;
+		
+	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);
+		}
+	    } else {
+		result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL,
+					       valuePtr, &i1);
+		i1 = (i1 != 0);
+	    }
+	    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 (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != 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 gotError;
+		
+	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);
+		}
+	    } else {
+		result = Tcl_GetBooleanFromObj((Tcl_Interp *) NULL, value2Ptr, &i2);
+	    }
+	    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;
+	    }
 	}
 
+	/*
+	 * Reuse the valuePtr object already on stack if possible.
+	 */
+	
 	if (*pc == INST_LOR) {
 	    iResult = (i1 || i2);
 	} else {
 	    iResult = (i1 && i2);
 	}
-	objResultPtr = TCONST(iResult);
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
-	NEXT_INST_F(1, 2, 1);
+	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);
+	}
     }
 
     /*
-     * -----------------------------------------------------------------
-     *	   Start of INST_LIST and related instructions.
+     * ---------------------------------------------------------
+     *     Start of INST_LIST and related instructions.
      */
 
-    {
-	int index, numIndices, fromIdx, toIdx;
-	int nocase, match, length2, cflags, s1len, s2len;
-	const char *s1, *s2;
-
     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. 
 	 */
 
 	opnd = TclGetUInt4AtPtr(pc+1);
-	objResultPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1));
+	objResultPtr = Tcl_NewListObj(opnd, &(stackPtr[stackTop - (opnd-1)]));
 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
 	NEXT_INST_V(5, opnd, 1);
 
     case INST_LIST_LENGTH:
-	valuePtr = OBJ_AT_TOS;
-	if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) {
+	valuePtr = stackPtr[stackTop];
+
+	result = Tcl_ListObjLength(interp, valuePtr, &length);
+	if (result != TCL_OK) {
 	    TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)),
-		    Tcl_GetObjResult(interp));
-	    goto gotError;
+	            Tcl_GetObjResult(interp));
+	    goto checkForCatch;
 	}
-	TclNewIntObj(objResultPtr, length);
+	objResultPtr = Tcl_NewIntObj(length);
 	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
 	NEXT_INST_F(1, 1, 1);
-
-    case INST_LIST_INDEX:	/* lindex with objc == 3 */
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-
-	/*
-	 * Extract the desired list element.
-	 */
-
-	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
-		&& (value2Ptr->typePtr != &tclListType)
-		&& (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
-			&index) == TCL_OK)) {
-	    TclDecrRefCount(value2Ptr);
-	    tosPtr--;
-	    pcAdjustment = 1;
-	    goto lindexFastPath;
-	}
-
-	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
-	if (!objResultPtr) {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr),
-		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
-
+	    
+    case INST_LIST_INDEX:
+	/*** lindex with objc == 3 ***/
+		
 	/*
-	 * Stash the list element on the stack.
+	 * Pop the two operands
 	 */
-
-	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_IMM:	/* lindex with objc==3 and index in bytecode
-				 * stream */
+	value2Ptr = stackPtr[stackTop];
+	valuePtr  = stackPtr[stackTop- 1];
 
 	/*
-	 * Pop the list and get the index.
+	 * Extract the desired list element
 	 */
-
-	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.
-	 */
-
-	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd),
-		    Tcl_GetObjResult(interp));
-	    goto gotError;
+	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
+	if (objResultPtr == NULL) {
+	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), O2S(value2Ptr)),
+	            Tcl_GetObjResult(interp));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
 
 	/*
-	 * Select the list item based on the index. Negative operand means
-	 * end-based indexing.
+	 * 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 */
 
-	if (opnd < -1) {
-	    index = opnd+1 + objc;
-	} else {
-	    index = opnd;
-	}
-	pcAdjustment = 5;
-
-    lindexFastPath:
-	if (index >= 0 && index < objc) {
-	    objResultPtr = objv[index];
-	} else {
-	    TclNewObj(objResultPtr);
-	}
-
-	TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
-		objResultPtr);
-	NEXT_INST_F(pcAdjustment, 1, 1);
-
-    case INST_LIST_INDEX_MULTI:	/* 'lindex' with multiple index args */
+    case INST_LIST_INDEX_MULTI:
+    {
 	/*
+	 * 'lindex' with multiple index args:
+	 *
 	 * Determine the count of index args.
 	 */
 
+	int numIdx;
+
 	opnd = TclGetUInt4AtPtr(pc+1);
-	numIndices = opnd-1;
+	numIdx = opnd-1;
 
 	/*
 	 * Do the 'lindex' operation.
 	 */
+	objResultPtr = TclLindexFlat(interp, stackPtr[stackTop - numIdx],
+	        numIdx, stackPtr + stackTop - numIdx + 1);
 
-	objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices),
-		numIndices, &OBJ_AT_DEPTH(numIndices - 1));
-	if (!objResultPtr) {
+	/*
+	 * Check for errors
+	 */
+	if (objResultPtr == NULL) {
 	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
-	    goto gotError;
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
 
 	/*
-	 * Set result.
+	 * Set result
 	 */
-
 	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
 	NEXT_INST_V(5, opnd, -1);
+    }
 
     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);
-	numIndices = opnd - 2;
+	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 - we can use the smaller macro
-	 * Tcl_DecrRefCount.
+	 * 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.
 	 */
-
-	valuePtr = POP_OBJECT();
-	Tcl_DecrRefCount(valuePtr); /* This one should be done here */
+	value2Ptr = POP_OBJECT();
+	TclDecrRefCount(value2Ptr); /* This one should be done here */
 
 	/*
-	 * Compute the new variable value.
+	 * Get the new element value.
 	 */
-
-	objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
-		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
-	if (!objResultPtr) {
-	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
+	valuePtr = stackPtr[stackTop];
 
 	/*
-	 * Set result.
+	 * Compute the new variable value
 	 */
+	objResultPtr = TclLsetFlat(interp, value2Ptr, numIdx,
+	        stackPtr + stackTop - numIdx, valuePtr);
 
-	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
-	NEXT_INST_V(5, numIndices+1, -1);
 
-    case INST_LSET_LIST:	/* '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 - we can use the smaller macro
-	 * Tcl_DecrRefCount.
+	 * Check for errors
 	 */
-
-	objPtr = POP_OBJECT();
-	Tcl_DecrRefCount(objPtr);	/* This one should be done here. */
+	if (objResultPtr == NULL) {
+	    TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
+	}
 
 	/*
-	 * Get the new element value, and the index list.
+	 * Set result
 	 */
+	TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
+	NEXT_INST_V(5, (numIdx+1), -1);
+    }
 
-	valuePtr = OBJ_AT_TOS;
-	value2Ptr = OBJ_UNDER_TOS;
-
+    case INST_LSET_LIST:
 	/*
-	 * Compute the new variable value.
+	 * '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.
 	 */
-
-	objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
-	if (!objResultPtr) {
-	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
-		    Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
-
+	objPtr = POP_OBJECT(); 
+	TclDecrRefCount(objPtr); /* This one should be done here */
+	
 	/*
-	 * Set result.
+	 * Get the new element value, and the index list
 	 */
-
-	TRACE(("=> %s\n", O2S(objResultPtr)));
-	NEXT_INST_F(1, 2, -1);
-
-    case INST_LIST_RANGE_IMM:	/* lrange with objc==4 and both indices in
-				 * bytecode stream */
-
+	valuePtr = stackPtr[stackTop];
+	value2Ptr = stackPtr[stackTop - 1];
+	
 	/*
-	 * Pop the list and get the indices.
+	 * Compute the new variable value
 	 */
-
-	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.
-	 */
-
-	if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr),
-		    fromIdx, toIdx), Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
+	objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr);
 
 	/*
-	 * Skip a lot of work if we're about to throw the result away (common
-	 * with uses of [lassign]).
+	 * Check for errors
 	 */
-
-#ifndef TCL_COMPILE_DEBUG
-	if (*(pc+9) == INST_POP) {
-	    NEXT_INST_F(10, 1, 0);
+	if (objResultPtr == NULL) {
+	    TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)),
+	            Tcl_GetObjResult(interp));
+	    result = TCL_ERROR;
+	    goto checkForCatch;
 	}
-#endif
 
 	/*
-	 * Adjust the indices for end-based handling.
+	 * Set result
 	 */
+	TRACE(("=> %s\n", O2S(objResultPtr)));
+	NEXT_INST_F(1, 2, -1);
 
-	if (fromIdx < -1) {
-	    fromIdx += 1+objc;
-	    if (fromIdx < -1) {
-		fromIdx = -1;
-	    }
-	} else if (fromIdx > objc) {
-	    fromIdx = objc;
-	}
-	if (toIdx < -1) {
-	    toIdx += 1 + objc;
-	    if (toIdx < -1) {
-		toIdx = -1;
-	    }
-	} else if (toIdx > objc) {
-	    toIdx = objc;
-	}
+    /*
+     *     End of INST_LIST and related instructions.
+     * ---------------------------------------------------------
+     */
 
+    case INST_STR_EQ:
+    case INST_STR_NEQ:
+    {
 	/*
-	 * Check if we are referring to a valid, non-empty list range, and if
-	 * so, build the list of elements in that range.
+	 * String (in)equality check
 	 */
+	int iResult;
 
-	if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
-	    if (fromIdx < 0) {
-		fromIdx = 0;
-	    }
-	    if (toIdx >= objc) {
-		toIdx = objc-1;
-	    }
-	    if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {
-		/*
-		 * BEWARE! This is looking inside the implementation of the
-		 * list type.
-		 */
-
-		List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;
-
-		if (listPtr->refCount == 1) {
-		    TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),
-			    TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)));
-		    for (index=toIdx+1 ; index<objc-1 ; index++) {
-			TclDecrRefCount(objv[index]);
-		    }
-		    listPtr->elemCount = toIdx+1;
-		    listPtr->canonicalFlag = 1;
-		    TclInvalidateStringRep(valuePtr);
-		    TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
-		    NEXT_INST_F(9, 0, 0);
-		}
-	    }
-	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+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. */
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-
-	s1 = TclGetStringFromObj(valuePtr, &s1len);
-	if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) {
-	    TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr),
-		    O2S(value2Ptr)), Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
-	match = 0;
-	if (length > 0) {
-	    int i = 0;
-	    Tcl_Obj *o;
+	value2Ptr = stackPtr[stackTop];
+	valuePtr = stackPtr[stackTop - 1];
 
+	if (valuePtr == value2Ptr) {
 	    /*
-	     * An empty list doesn't match anything.
+	     * 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;
 
-	    do {
-		Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
-		if (o != NULL) {
-		    s2 = TclGetStringFromObj(o, &s2len);
+	    s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+	    s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
+	    if (s1len == s2len) {
+		/*
+		 * We only need to check (in)equality when
+		 * we have equal length strings.
+		 */
+		if (*pc == INST_STR_NEQ) {
+		    iResult = (strcmp(s1, s2) != 0);
 		} else {
-		    s2 = "";
-		    s2len = 0;
-		}
-		if (s1len == s2len) {
-		    match = (memcmp(s1, s2, s1len) == 0);
+		    /* INST_STR_EQ */
+		    iResult = (strcmp(s1, s2) == 0);
 		}
-		i++;
-	    } while (i < length && match == 0);
+	    } else {
+		iResult = (*pc == INST_STR_NEQ);
+	    }
 	}
 
-	if (*pc == INST_LIST_NOT_IN) {
-	    match = !match;
-	}
-
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
 
 	/*
-	 * 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.
+	 * 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((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((match ? 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 = TCONST(match);
+	objResultPtr = Tcl_NewIntObj(iResult);
 	NEXT_INST_F(0, 2, 1);
+    }
 
-    /*
-     *	   End of INST_LIST and related instructions.
-     * -----------------------------------------------------------------
-     *	   Start of string-related instructions.
-     */
+    case INST_STR_CMP:
+    {
+	/*
+	 * String compare
+	 */
+	CONST char *s1, *s2;
+	int s1len, s2len, iResult;
 
-    case INST_STR_EQ:
-    case INST_STR_NEQ:		/* String (in)equality check */
-    case INST_STR_CMP:		/* String compare. */
-    stringCompare:
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
+	value2Ptr = stackPtr[stackTop];
+	valuePtr = stackPtr[stackTop - 1];
 
+	/*
+	 * The comparison function should compare up to the
+	 * minimum byte length only.
+	 */
 	if (valuePtr == value2Ptr) {
-	    match = 0;
-	} else {
 	    /*
-	     * We only need to check (in)equality when we have equal length
-	     * strings.  We can use memcmp in all (n)eq cases because we
-	     * don't need to worry about lexical LE/BE variance.
+	     * 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)) {
+	    s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
+	    s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
+	    iResult = memcmp(s1, s2, 
+	            (size_t) ((s1len < s2len) ? s1len : s2len));
+	} else if (((valuePtr->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
+	     * check between the unicode and string comparison operations.
 	     */
 
-	    typedef int (*memCmpFn_t)(const void*, const void*, size_t);
-	    memCmpFn_t memCmpFn;
-	    int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
-		    || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
-
-	    if (TclIsPureByteArray(valuePtr)
-		    && TclIsPureByteArray(value2Ptr)) {
-		s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
-		s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
-		memCmpFn = memcmp;
-	    } else if (((valuePtr->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
-		 * check between the unicode and string comparison operations.
-		 */
-
-		s1len = Tcl_GetCharLength(valuePtr);
-		s2len = Tcl_GetCharLength(value2Ptr);
-		if ((s1len == valuePtr->length)
-			&& (s2len == value2Ptr->length)) {
-		    s1 = valuePtr->bytes;
-		    s2 = value2Ptr->bytes;
-		    memCmpFn = memcmp;
-		} else {
-		    s1 = (char *) Tcl_GetUnicode(valuePtr);
-		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
-		    if (
-#ifdef WORDS_BIGENDIAN
-			1
-#else
-			checkEq
-#endif
-			) {
-			memCmpFn = memcmp;
-			s1len *= sizeof(Tcl_UniChar);
-			s2len *= sizeof(Tcl_UniChar);
-		    } else {
-			memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
-		    }
-		}
-	    } else {
-		/*
-		 * strcmp can't do a simple memcmp in order to handle the
-		 * special Tcl \xC0\x80 null encoding for utf-8.
-		 */
-
-		s1 = TclGetStringFromObj(valuePtr, &s1len);
-		s2 = TclGetStringFromObj(value2Ptr, &s2len);
-		if (checkEq) {
-		    memCmpFn = memcmp;
-		} else {
-		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
-		}
-	    }
-
-	    if (checkEq && (s1len != s2len)) {
-		match = 1;
+	    s1len = Tcl_GetCharLength(valuePtr);
+	    s2len = Tcl_GetCharLength(value2Ptr);
+	    if ((s1len == valuePtr->length) && (s2len == value2Ptr->length)) {
+		iResult = memcmp(valuePtr->bytes, value2Ptr->bytes,
+			(unsigned) ((s1len < s2len) ? s1len : s2len));
 	    } else {
-		/*
-		 * The comparison function should compare up to the minimum
-		 * byte length only.
-		 */
-		match = memCmpFn(s1, s2,
-			(size_t) ((s1len < s2len) ? s1len : s2len));
-		if (match == 0) {
-		    match = s1len - s2len;
-		}
+		iResult = TclUniCharNcmp(Tcl_GetUnicode(valuePtr),
+			Tcl_GetUnicode(value2Ptr),
+			(unsigned) ((s1len < s2len) ? s1len : s2len));
 	    }
+	} else {
+	    /*
+	     * 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);
+	    iResult = TclpUtfNcmp2(s1, s2,
+	            (size_t) ((s1len < s2len) ? s1len : s2len));
 	}
 
 	/*
 	 * Make sure only -1,0,1 is returned
-	 * TODO: consider peephole opt.
 	 */
-
-	if (*pc != INST_STR_CMP) {
-	    /*
-	     * Take care of the opcodes that goto'ed into here.
-	     */
-
-	    switch (*pc) {
-	    case INST_STR_EQ:
-	    case INST_EQ:
-		match = (match == 0);
-		break;
-	    case INST_STR_NEQ:
-	    case INST_NEQ:
-		match = (match != 0);
-		break;
-	    case INST_LT:
-		match = (match < 0);
-		break;
-	    case INST_GT:
-		match = (match > 0);
-		break;
-	    case INST_LE:
-		match = (match <= 0);
-		break;
-	    case INST_GE:
-		match = (match >= 0);
-		break;
-	    }
+	if (iResult == 0) {
+	    iResult = s1len - s2len;
 	}
-	if (match < 0) {
-	    TclNewIntObj(objResultPtr, -1);
-	} else {
-	    objResultPtr = TCONST(match > 0);
+	if (iResult < 0) {
+	    iResult = -1;
+	} else if (iResult > 0) {
+	    iResult = 1;
 	}
-	TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr),
-		O2S(objResultPtr)));
+
+	objResultPtr = Tcl_NewIntObj(iResult);
+	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), iResult));
 	NEXT_INST_F(1, 2, 1);
+    }
 
     case INST_STR_LEN:
-	valuePtr = OBJ_AT_TOS;
-	length = Tcl_GetCharLength(valuePtr);
-	TclNewIntObj(objResultPtr, length);
-	TRACE(("%.20s => %d\n", O2S(valuePtr), length));
-	NEXT_INST_F(1, 1, 1);
+    {
+	int length1;
+		 
+	valuePtr = stackPtr[stackTop];
 
+	if (valuePtr->typePtr == &tclByteArrayType) {
+	    (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
+	} else {
+	    length1 = Tcl_GetCharLength(valuePtr);
+	}
+	objResultPtr = Tcl_NewIntObj(length1);
+	TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
+	NEXT_INST_F(1, 1, 1);
+    }
+	    
     case INST_STR_INDEX:
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-
+    {
 	/*
-	 * Get char length to calulate what 'end' means.
+	 * String compare
 	 */
+	int index;
+	bytes = NULL; /* lint */
 
-	length = Tcl_GetCharLength(valuePtr);
-	if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
-	    goto gotError;
-	}
+	value2Ptr = stackPtr[stackTop];
+	valuePtr = stackPtr[stackTop - 1];
 
-	if ((index < 0) || (index >= length)) {
-	    TclNewObj(objResultPtr);
-	} else if (TclIsPureByteArray(valuePtr)) {
-	    objResultPtr = Tcl_NewByteArrayObj(
-		    Tcl_GetByteArrayFromObj(valuePtr, &length)+index, 1);
-	} else if (valuePtr->bytes && length == valuePtr->length) {
-	    objResultPtr = Tcl_NewStringObj((const char *)
-		    valuePtr->bytes+index, 1);
-	} else {
-	    char buf[TCL_UTF_MAX];
-	    Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
+	/*
+	 * 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) {
+	    bytes = (char *)Tcl_GetByteArrayFromObj(valuePtr, &length);
+	} else {
 	    /*
-	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
-	     * but creating the object as a string seems to be faster in
-	     * practical use.
+	     * Get Unicode char length to calulate what 'end' means.
 	     */
+	    length = Tcl_GetCharLength(valuePtr);
+	}
 
-	    length = Tcl_UniCharToUtf(ch, buf);
-	    objResultPtr = Tcl_NewStringObj(buf, length);
+	result = TclGetIntForIndex(interp, value2Ptr, length - 1, &index);
+	if (result != TCL_OK) {
+	    goto checkForCatch;
+	}
+
+	if ((index >= 0) && (index < length)) {
+	    if (valuePtr->typePtr == &tclByteArrayType) {
+		objResultPtr = Tcl_NewByteArrayObj((unsigned char *)
+		        (&bytes[index]), 1);
+	    } else if (valuePtr->bytes && length == valuePtr->length) {
+		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.
+		 */
+		length = Tcl_UniCharToUtf(ch, buf);
+		objResultPtr = Tcl_NewStringObj(buf, length);
+	    }
+	} else {
+	    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:
-	nocase = TclGetInt1AtPtr(pc+1);
-	valuePtr = OBJ_AT_TOS;		/* String */
-	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
+    {
+	int nocase, match;
+
+	nocase    = TclGetInt1AtPtr(pc+1);
+	valuePtr  = stackPtr[stackTop];	        /* String */
+	value2Ptr = stackPtr[stackTop - 1];	/* 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;
 
-	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
+	    ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length1);
 	    ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2);
-	    match = TclUniCharMatch(ustring1, length, ustring2, length2,
+	    match = TclUniCharMatch(ustring1, length1, ustring2, length2,
 		    nocase);
-	} else if (TclIsPureByteArray(valuePtr) && !nocase) {
-	    unsigned char *bytes1, *bytes2;
-
-	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &length);
-	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &length2);
-	    match = TclByteArrayMatch(bytes1, length, bytes2, 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
 	 */
 
 	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+	if (Tcl_IsShared(value2Ptr)) {
+	    objResultPtr = Tcl_NewIntObj(match);
+	    NEXT_INST_F(2, 2, 1);
+	} else {	/* reuse the valuePtr object */
+	    Tcl_SetIntObj(value2Ptr, match);
+	    NEXT_INST_F(2, 1, 0);
+	}
+    }
 
+    case INST_EQ:
+    case INST_NEQ:
+    case INST_LT:
+    case INST_GT:
+    case INST_LE:
+    case INST_GE:
+    {
 	/*
-	 * Peep-hole optimisation: if you're about to jump, do jump from here.
+	 * Any type is allowed but the two operands must have the
+	 * same type. We will compute value op value2.
 	 */
 
-	pc += 2;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
-	}
-#endif
-	objResultPtr = TCONST(match);
-	NEXT_INST_F(0, 2, 1);
+	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_REGEXP:
-	cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */
-	valuePtr = OBJ_AT_TOS;		/* String */
-	value2Ptr = OBJ_UNDER_TOS;	/* Pattern */
+	value2Ptr = stackPtr[stackTop];
+	valuePtr  = stackPtr[stackTop - 1];
 
 	/*
-	 * Compile and match the regular expression.
+	 * Be careful in the equal-object case; 'NaN' isn't supposed
+	 * to be equal to even itself. [Bug 761471]
 	 */
 
-	{
-	    Tcl_RegExp regExpr =
-		    Tcl_GetRegExpFromObj(interp, value2Ptr, cflags);
+	t1Ptr = valuePtr->typePtr;
+	if (valuePtr == value2Ptr) {
+	    /*
+	     * 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.
+	     */
+	    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
+		     */
 
-	    if (regExpr == NULL) {
-		goto regexpFailure;
+		  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;
+		}
 	    }
 
-	    match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0);
-
-	    if (match < 0) {
-	    regexpFailure:
-#ifdef TCL_COMPILE_DEBUG
-		objResultPtr = Tcl_GetObjResult(interp);
-		TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ",
-			O2S(valuePtr), O2S(value2Ptr)), objResultPtr);
-#endif
-		goto gotError;
+	    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;
 	    }
+	    goto foundResult;
 	}
 
-	TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match));
+	t2Ptr = value2Ptr->typePtr;
 
 	/*
-	 * Peep-hole optimisation: if you're about to jump, do jump from here.
-	 * Adjustment is 2 due to the nocase byte.
+	 * 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]).
 	 */
-
-	pc += 2;
-#ifndef TCL_COMPILE_DEBUG
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0);
+	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);
+		}
+		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;
+	    }
 	}
-#endif
-	objResultPtr = TCONST(match);
-	NEXT_INST_F(0, 2, 1);
-    }
-
-    /*
-     *	   End of string-related instructions.
-     * -----------------------------------------------------------------
-     *	   Start of numeric operator instructions.
-     */
-
-    {
-	ClientData ptr1, ptr2;
-	int type1, type2;
-	long l1, l2, lResult;
-
-    case INST_EQ:
-    case INST_NEQ:
-    case INST_LT:
-    case INST_GT:
-    case INST_LE:
-    case INST_GE: {
-	int iResult = 0, compare = 0;
-
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-
-	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
+	if (!IS_NUMERIC_TYPE(t1Ptr) || !IS_NUMERIC_TYPE(t2Ptr)) {
 	    /*
-	     * At least one non-numeric argument - compare as strings.
+	     * 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.
 	     */
-
-	    goto stringCompare;
-	}
-	if (type1 == TCL_NUMBER_NAN) {
+	    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);
+		    break;
+	        case INST_GE:
+		    iResult = (strcmp(s1, s2) >= 0);
+		    break;
+	    }
+	} else if ((t1Ptr == &tclDoubleType)
+		   || (t2Ptr == &tclDoubleType)) {
 	    /*
-	     * NaN first arg: NaN != to everything, other compares are false.
+	     * Compare as doubles.
 	     */
-
-	    iResult = (*pc == INST_NEQ);
-	    goto foundResult;
-	}
-	if (valuePtr == value2Ptr) {
-	    compare = MP_EQ;
-	    goto convertComparison;
-	}
-	if (GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
+	    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;
+	        case INST_GE:
+		    iResult = d1 >= d2;
+		    break;
+	    }
+	} else if ((t1Ptr == &tclWideIntType)
+	        || (t2Ptr == &tclWideIntType)) {
+	    Tcl_WideInt w2;
 	    /*
-	     * At least one non-numeric argument - compare as strings.
+	     * Compare as wide ints (neither are doubles)
 	     */
-
-	    goto stringCompare;
-	}
-	if (type2 == TCL_NUMBER_NAN) {
+	    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;
+	        case INST_NEQ:
+		    iResult = w != w2;
+		    break;
+	        case INST_LT:
+		    iResult = w < w2;
+		    break;
+	        case INST_GT:
+		    iResult = w > w2;
+		    break;
+	        case INST_LE:
+		    iResult = w <= w2;
+		    break;
+	        case INST_GE:
+		    iResult = w >= w2;
+		    break;
+	    }
+	} else {
 	    /*
-	     * NaN 2nd arg: NaN != to everything, other compares are false.
+	     * Compare as ints.
 	     */
-
-	    iResult = (*pc == INST_NEQ);
-	    goto foundResult;
-	}
-	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
-	    l1 = *((const long *)ptr1);
-	    l2 = *((const long *)ptr2);
-	    compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
-	} else {
-	    compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
+	    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 INST_GE:
+		    iResult = i >= i2;
+		    break;
+	    }
 	}
 
-	/*
-	 * 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;
-	}
+    foundResult:
+	TRACE(("%.20s %.20s => %ld\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.
 	 */
 
-    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 = TCONST(iResult);
+	objResultPtr = Tcl_NewIntObj(iResult);
 	NEXT_INST_F(0, 2, 1);
     }
 
@@ -4820,3049 +3163,1372 @@ TEBCresume(
     case INST_BITOR:
     case INST_BITXOR:
     case INST_BITAND:
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-
-	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
-		|| (type1==TCL_NUMBER_DOUBLE) || (type1==TCL_NUMBER_NAN)) {
-	    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 gotError;
-	}
-
-	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
-		|| (type2==TCL_NUMBER_DOUBLE) || (type2==TCL_NUMBER_NAN)) {
-	    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 gotError;
-	}
-
+    {
 	/*
-	 * Check for common, simple case.
+	 * Only integers are allowed. We compute value op value2.
 	 */
 
-	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
-	    l1 = *((const long *)ptr1);
-	    l2 = *((const long *)ptr2);
-
-	    switch (*pc) {
-	    case INST_MOD:
-		if (l2 == 0) {
-		    TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
-			    O2S(value2Ptr)));
-		    goto divideByZero;
-		} else if ((l2 == 1) || (l2 == -1)) {
-		    /*
-		     * Div. by |1| always yields remainder of 0.
-		     */
-
-		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		    objResultPtr = TCONST(0);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
-		} else if (l1 == 0) {
-		    /*
-		     * 0 % (non-zero) always yields remainder of 0.
-		     */
+	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;
+	    }
+	}
+	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;
+	    }
+	}
 
-		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		    objResultPtr = TCONST(0);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
+	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 {
-		    lResult = l1 / l2;
-
-		    /*
-		     * Force Tcl's integer division rules.
-		     * TODO: examine for logic simplification
-		     */
-
-		    if ((lResult < 0 || (lResult == 0 &&
-			    ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
-			    (lResult * l2 != l1)) {
-			lResult -= 1;
-		    }
-		    lResult = l1 - l2*lResult;
-		    goto longResultOfArithmetic;
+		    TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
 		}
-
-	    case INST_RSHIFT:
-		if (l2 < 0) {
-		    Tcl_SetResult(interp, "negative shift argument",
-			    TCL_STATIC);
-#if 0
-		    DECACHE_STACK_INFO();
-		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
-			    "domain error: argument not in valid range",
-			    NULL);
-		    CACHE_STACK_INFO();
-#endif
-		    goto gotError;
-		} else if (l1 == 0) {
-		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		    objResultPtr = TCONST(0);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
+		goto divideByZero;
+	    }
+	    if (value2Ptr->typePtr == &tclIntType && i2 == 0) {
+		if (valuePtr->typePtr == &tclIntType) {
+		    TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
 		} else {
-		    /*
-		     * Quickly force large right shifts to 0 or -1.
-		     */
-
-		    if (l2 >= (long)(CHAR_BIT*sizeof(long))) {
-			/*
-			 * We assume that INT_MAX is much larger than the
-			 * number of bits in a long. This is a pretty safe
-			 * assumption, given that the former is usually around
-			 * 4e9 and the latter 32 or 64...
-			 */
-
-			TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-			if (l1 > 0L) {
-			    objResultPtr = TCONST(0);
-			} else {
-			    TclNewIntObj(objResultPtr, -1);
-			}
-			TRACE(("%s\n", O2S(objResultPtr)));
-			NEXT_INST_F(1, 2, 1);
-		    }
-
-		    /*
-		     * Handle shifts within the native long range.
-		     */
-
-		    lResult = l1 >> ((int) l2);
-		    goto longResultOfArithmetic;
+		    TRACE((LLD" %ld => DIVIDE BY ZERO\n", w, i2));
 		}
-
-	    case INST_LSHIFT:
-		if (l2 < 0) {
-		    Tcl_SetResult(interp, "negative shift argument",
-			    TCL_STATIC);
-#if 0
-		    DECACHE_STACK_INFO();
-		    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
-			    "domain error: argument not in valid range",
-			    NULL);
-		    CACHE_STACK_INFO();
-#endif
-		    goto gotError;
-		} else if (l1 == 0) {
-		    TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-		    objResultPtr = TCONST(0);
-		    TRACE(("%s\n", O2S(objResultPtr)));
-		    NEXT_INST_F(1, 2, 1);
-		} else if (l2 > (long) INT_MAX) {
-		    /*
-		     * Technically, we could hold the value (1 << (INT_MAX+1))
-		     * in an mp_int, but since we're using mp_mul_2d() to do
-		     * the work, and it takes only an int argument, that's a
-		     * good place to draw the line.
-		     */
-
-		    Tcl_SetResult(interp,
-			    "integer value too large to represent",
-			    TCL_STATIC);
-#if 0
-		    DECACHE_STACK_INFO();
-		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
-			    "integer value too large to represent", NULL);
-		    CACHE_STACK_INFO();
-#endif
-		    goto gotError;
+		goto divideByZero;
+	    }
+	    negative = 0;
+	    if (valuePtr->typePtr == &tclWideIntType
+		|| value2Ptr->typePtr == &tclWideIntType) {
+		Tcl_WideInt wRemainder;
+		/*
+		 * Promote to wide
+		 */
+		if (valuePtr->typePtr == &tclIntType) {
+		    w = Tcl_LongAsWide(i);
+		} else if (value2Ptr->typePtr == &tclIntType) {
+		    w2 = Tcl_LongAsWide(i2);
+		}
+		if (w2 < 0) {
+		    w2 = -w2;
+		    w = -w;
+		    negative = 1;
+		}
+		wRemainder  = w % w2;
+		if (wRemainder < 0) {
+		    wRemainder += w2;
+		}
+		if (negative) {
+		    wRemainder = -wRemainder;
+		}
+		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;
+	    }
+	    iResult = rem;
+	    break;
+	case INST_LSHIFT:
+	    /*
+	     * Shifts are never usefully 64-bits wide!
+	     */
+	    FORCE_LONG(value2Ptr, i2, w2);
+	    if (valuePtr->typePtr == &tclWideIntType) {
+#ifdef TCL_COMPILE_DEBUG
+		w2 = Tcl_LongAsWide(i2);
+#endif /* TCL_COMPILE_DEBUG */
+		wResult = w;
+		/*
+		 * Shift in steps when the shift gets large to prevent
+		 * annoying compiler/processor bugs. [Bug 868467]
+		 */
+		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 {
-		    int shift = (int) l2;
-
-		    /*
-		     * Handle shifts within the native long range.
-		     */
-
-		    if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0)
-			    && !((l1>0 ? l1 : ~l1) &
-				-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
-			lResult = l1 << shift;
-			goto longResultOfArithmetic;
-		    }
+		    wResult = w << i2;
+		}
+		doWide = 1;
+		break;
+	    }
+	    /*
+	     * Shift in steps when the shift gets large to prevent
+	     * annoying compiler/processor bugs. [Bug 868467]
+	     */
+	    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;
+	    }
+	    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.
+	     */
+	    /*
+	     * Shifts are never usefully 64-bits wide!
+	     */
+	    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;
 		}
-
 		/*
-		 * Too large; need to use the broken-out function.
+		 * Shift in steps when the shift gets large to prevent
+		 * annoying compiler/processor bugs. [Bug 868467]
 		 */
-
-		TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
+		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;
+		} else {
+		    wResult >>= i2;
+		}
+		if (w < 0) {
+		    wResult = ~wResult;
+		}
+		doWide = 1;
 		break;
-
-	    case INST_BITAND:
-		lResult = l1 & l2;
-		goto longResultOfArithmetic;
-	    case INST_BITOR:
-		lResult = l1 | l2;
-		goto longResultOfArithmetic;
-	    case INST_BITXOR:
-		lResult = l1 ^ l2;
-	    longResultOfArithmetic:
-		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);
+	    }
+	    if (i < 0) {
+		iResult = ~i;
+	    } else {
+		iResult = i;
+	    }
+	    /*
+	     * Shift in steps when the shift gets large to prevent
+	     * annoying compiler/processor bugs. [Bug 868467]
+	     */
+	    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;
+	    } else {
+		iResult >>= i2;
+	    }
+	    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);
 		}
-		TclSetLongObj(valuePtr, lResult);
-		TRACE(("%s\n", O2S(valuePtr)));
-		NEXT_INST_F(1, 1, 0);
+		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);
+		}
+		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);
+		}
+		wResult = w & w2;
+		doWide = 1;
+		break;
+	    }
+	    iResult = i & i2;
+	    break;
 	}
 
 	/*
-	 * DO NOT MERGE THIS WITH THE EQUIVALENT SECTION LATER! That would
-	 * encourage the compiler to inline ExecuteExtendedBinaryMathOp, which
-	 * is highly undesirable due to the overall impact on size.
+	 * Reuse the valuePtr object already on stack if possible.
 	 */
-
-	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
-		valuePtr, value2Ptr);
-	if (objResultPtr == DIVIDED_BY_ZERO) {
-	    TRACE_APPEND(("DIVIDE BY ZERO\n"));
-	    goto divideByZero;
-	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
-	    TRACE_APPEND(("ERROR: %s\n",
-		    TclGetString(Tcl_GetObjResult(interp))));
-	    goto gotError;
-	} else if (objResultPtr == NULL) {
-	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 1, 0);
-	} else {
-	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
+		
+	if (Tcl_IsShared(valuePtr)) {
+	    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 (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);
 	}
+    }
 
-    case INST_EXPON:
     case INST_ADD:
     case INST_SUB:
-    case INST_DIV:
     case INST_MULT:
-	value2Ptr = OBJ_AT_TOS;
-	valuePtr = OBJ_UNDER_TOS;
-
-	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
-		|| IsErroringNaNType(type1)) {
-	    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 gotError;
-	}
+    case INST_DIV:
+    {
+	/*
+	 * Operands must be numeric and ints get converted to floats
+	 * if necessary. We compute value op value2.
+	 */
 
-#ifdef ACCEPT_NAN
-	if (type1 == TCL_NUMBER_NAN) {
+	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)) {
 	    /*
-	     * NaN first argument -> result is also 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.
 	     */
 
-	    NEXT_INST_F(1, 1, 0);
-	}
-#endif
-
-	if ((GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK)
-		|| IsErroringNaNType(type2)) {
-	    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 gotError;
+	    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;
 	}
 
-#ifdef ACCEPT_NAN
-	if (type2 == TCL_NUMBER_NAN) {
+	if (t2Ptr == &tclIntType) {
+	    i2 = value2Ptr->internalRep.longValue;
+	} else if (t2Ptr == &tclWideIntType) {
+	    TclGetWide(w2,value2Ptr);
+	} else if ((t2Ptr == &tclDoubleType)
+		   && (value2Ptr->bytes == NULL)) {
 	    /*
-	     * NaN second argument -> result is also 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.
 	     */
 
-	    objResultPtr = value2Ptr;
-	    NEXT_INST_F(1, 2, 1);
+	    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;
 	}
-#endif
-
-	/*
-	 * Handle (long,long) arithmetic as best we can without going out to
-	 * an external function.
-	 */
-
-	if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
-	    Tcl_WideInt w1, w2, wResult;
-
-	    l1 = *((const long *)ptr1);
-	    l2 = *((const long *)ptr2);
 
+	if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) {
+	    /*
+	     * Do double arithmetic.
+	     */
+	    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);
+	    }
 	    switch (*pc) {
-	    case INST_ADD:
-		w1 = (Tcl_WideInt) l1;
-		w2 = (Tcl_WideInt) l2;
-		wResult = w1 + w2;
-#ifdef NO_WIDE_TYPE
-		/*
-		 * Check for overflow.
-		 */
-
-		if (Overflowing(w1, w2, wResult)) {
-		    goto overflow;
-		}
-#endif
-		goto wideResultOfArithmetic;
-
-	    case INST_SUB:
-		w1 = (Tcl_WideInt) l1;
-		w2 = (Tcl_WideInt) l2;
-		wResult = w1 - w2;
-#ifdef NO_WIDE_TYPE
-		/*
-		 * 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.
-		 */
-
-		if (Overflowing(w1, ~w2, wResult)) {
-		    goto overflow;
-		}
-#endif
-	    wideResultOfArithmetic:
-		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);
-
-	    case INST_DIV:
-		if (l2 == 0) {
-		    TRACE(("%s %s => DIVIDE BY ZERO\n",
-			    O2S(valuePtr), O2S(value2Ptr)));
-		    goto divideByZero;
-		} else if ((l1 == LONG_MIN) && (l2 == -1)) {
+	        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;
+	    }
+		    
+	    /*
+	     * Check now for IEEE floating-point error.
+	     */
+		    
+	    if (IS_NAN(dResult) || IS_INF(dResult)) {
+		TRACE(("%.20s %.20s => IEEE FLOATING PT ERROR\n",
+		        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);
+	    }
+	    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:
 		    /*
-		     * Can't represent (-LONG_MIN) as a long.
+		     * 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.
 		     */
-
-		    goto overflow;
-		}
-		lResult = l1 / l2;
-
-		/*
-		 * Force Tcl's integer division rules.
-		 * TODO: examine for logic simplification
-		 */
-
-		if (((lResult < 0) || ((lResult == 0) &&
-			((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
-			((lResult * l2) != l1)) {
-		    lResult -= 1;
-		}
-		goto longResultOfArithmetic;
-
-	    case INST_MULT:
-		if (((sizeof(long) >= 2*sizeof(int))
-			&& (l1 <= INT_MAX) && (l1 >= INT_MIN)
-			&& (l2 <= INT_MAX) && (l2 >= INT_MIN))
-			|| ((sizeof(long) >= 2*sizeof(short))
-			&& (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN)
-			&& (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) {
-		    lResult = l1 * l2;
-		    goto longResultOfArithmetic;
-		}
+		    if (w2 == W0) {
+			TRACE((LLD" "LLD" => DIVIDE BY ZERO\n", w, w2));
+			goto divideByZero;
+		    }
+		    if (w2 < 0) {
+			w2 = -w2;
+			w = -w;
+		    }
+		    wquot = w / w2;
+		    wrem  = w % w2;
+		    if (wrem < W0) {
+			wquot -= 1;
+		    }
+		    wResult = wquot;
+		    break;
 	    }
-
+	} else {
 	    /*
-	     * Fall through with INST_EXPON, INST_DIV and large multiplies.
-	     */
+		     * Do integer arithmetic.
+		     */
+	    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:
+		    /*
+		     * 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 (i2 == 0) {
+			TRACE(("%ld %ld => DIVIDE BY ZERO\n", i, i2));
+			goto divideByZero;
+		    }
+		    if (i2 < 0) {
+			i2 = -i2;
+			i = -i;
+		    }
+		    quot = i / i2;
+		    rem  = i % i2;
+		    if (rem < 0) {
+			quot -= 1;
+		    }
+		    iResult = quot;
+		    break;
+	    }
 	}
 
-    overflow:
-	TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
-	objResultPtr = ExecuteExtendedBinaryMathOp(interp, *pc, &TCONST(0),
-		valuePtr, value2Ptr);
-	if (objResultPtr == DIVIDED_BY_ZERO) {
-	    TRACE_APPEND(("DIVIDE BY ZERO\n"));
-	    goto divideByZero;
-	} else if (objResultPtr == EXPONENT_OF_ZERO) {
-	    TRACE_APPEND(("EXPONENT OF ZERO\n"));
-	    goto exponOfZero;
-	} else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) {
-	    TRACE_APPEND(("ERROR: %s\n",
-		    TclGetString(Tcl_GetObjResult(interp))));
-	    goto gotError;
-	} else if (objResultPtr == NULL) {
-	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 1, 0);
-	} else {
-	    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
+	/*
+	 * 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);
 	}
+    }
 
-    case INST_LNOT: {
-	int b;
-
-	valuePtr = OBJ_AT_TOS;
+    case INST_UPLUS:
+    {
+	/*
+	 * Operand must be numeric.
+	 */
 
-	/* TODO - check claim that taking address of b harms performance */
-	/* TODO - consider optimization search for constants */
-	if (TclGetBooleanFromObj(NULL, valuePtr, &b) != 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 gotError;
+	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);
+	    }
+	    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;
+	    }
+	    tPtr = valuePtr->typePtr;
 	}
-	/* TODO: Consider peephole opt. */
-	objResultPtr = TCONST(!b);
-	NEXT_INST_F(1, 1, 1);
-    }
 
-    case INST_BITNOT:
-	valuePtr = OBJ_AT_TOS;
-	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
-		|| (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) {
-	    /*
-	     * ... ~$NonInteger => raise an error.
-	     */
+	/*
+	 * 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.
+	 */
 
-	    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 gotError;
-	}
-	if (type1 == TCL_NUMBER_LONG) {
-	    l1 = *((const long *) ptr1);
-	    if (Tcl_IsShared(valuePtr)) {
-		TclNewLongObj(objResultPtr, ~l1);
-		NEXT_INST_F(1, 1, 1);
+	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);
 	    }
-	    TclSetLongObj(valuePtr, ~l1);
-	    NEXT_INST_F(1, 0, 0);
-	}
-	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
-	if (objResultPtr != NULL) {
+	    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:
-	valuePtr = OBJ_AT_TOS;
-	if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK)
-		|| IsErroringNaNType(type1)) {
-	    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 gotError;
-	}
-	switch (type1) {
-	case TCL_NUMBER_NAN:
-	    /* -NaN => NaN */
-	    NEXT_INST_F(1, 0, 0);
-	case TCL_NUMBER_LONG:
-	    l1 = *((const long *) ptr1);
-	    if (l1 != LONG_MIN) {
-		if (Tcl_IsShared(valuePtr)) {
-		    TclNewLongObj(objResultPtr, -l1);
-		    NEXT_INST_F(1, 1, 1);
+    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;
+
+	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 (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;
 		}
-		TclSetLongObj(valuePtr, -l1);
-		NEXT_INST_F(1, 0, 0);
 	    }
-	    /* FALLTHROUGH */
+	    tPtr = valuePtr->typePtr;
 	}
-	objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr);
-	if (objResultPtr != NULL) {
+
+	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);
+		}
+		TRACE_WITH_OBJ((LLD" => ", w), objResultPtr);
+	    } else {
+		d = valuePtr->internalRep.doubleValue;
+		if (*pc == INST_UMINUS) {
+		    objResultPtr = Tcl_NewDoubleObj(-d);
+		} else {
+		    /*
+		     * Should be able to use "!d", but apparently
+		     * some compilers can't handle it.
+		     */
+		    objResultPtr = Tcl_NewLongObj((d==0.0)? 1 : 0);
+		}
+		TRACE_WITH_OBJ(("%.6g => ", d), objResultPtr);
+	    }
 	    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_WITH_OBJ((LLD" => ", w), valuePtr);
+	    } else {
+		d = valuePtr->internalRep.doubleValue;
+		if (*pc == INST_UMINUS) {
+		    Tcl_SetDoubleObj(valuePtr, -d);
+		} else {
+		    /*
+		     * Should be able to use "!d", but apparently
+		     * some compilers can't handle it.
+		     */
+		    Tcl_SetLongObj(valuePtr, (d==0.0)? 1 : 0);
+		}
+		TRACE_WITH_OBJ(("%.6g => ", d), valuePtr);
+	    }
 	    NEXT_INST_F(1, 0, 0);
 	}
+    }
 
-    case INST_UPLUS:
-    case INST_TRY_CVT_TO_NUMERIC:
+    case INST_BITNOT:
+    {
 	/*
-	 * 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.
+	 * 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.
 	 */
-
-	valuePtr = OBJ_AT_TOS;
-
-	if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) {
-	    if (*pc == INST_UPLUS) {
-		/*
-		 * ... +$NonNumeric => raise an error.
-		 */
-
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
-			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
+		
+	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 gotError;
+		goto checkForCatch;
 	    }
-
-	    /* ... TryConvertToNumeric($NonNumeric) is acceptable */
-	    TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 0, 0);
 	}
-	if (IsErroringNaNType(type1)) {
-	    if (*pc == INST_UPLUS) {
+		
+	if (valuePtr->typePtr == &tclWideIntType) {
+	    TclGetWide(w,valuePtr);
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_NewWideIntObj(~w);
+		TRACE(("0x%" TCL_LL_MODIFIER "x => (%" TCL_LL_MODIFIER "u)\n",
+			w, ~w));
+		NEXT_INST_F(1, 1, 1);
+	    } else {
 		/*
-		 * ... +$NonNumeric => raise an error.
+		 * valuePtr is unshared. Modify it directly.
 		 */
-
-		TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
-			(valuePtr->typePtr? valuePtr->typePtr->name:"null")));
-		DECACHE_STACK_INFO();
-		IllegalExprOperandType(interp, pc, valuePtr);
-		CACHE_STACK_INFO();
+		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;
+	    if (Tcl_IsShared(valuePtr)) {
+		objResultPtr = Tcl_NewLongObj(~i);
+		TRACE(("0x%lx => (%lu)\n", i, ~i));
+		NEXT_INST_F(1, 1, 1);
 	    } else {
 		/*
-		 * Numeric conversion of NaN -> error.
+		 * valuePtr is unshared. Modify it directly.
 		 */
-
-		TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n",
-			O2S(objResultPtr)));
-		DECACHE_STACK_INFO();
-		TclExprFloatError(interp, *((const double *) ptr1));
-		CACHE_STACK_INFO();
+		Tcl_SetLongObj(valuePtr, ~i);
+		TRACE(("0x%lx => (%lu)\n", i, ~i));
+		NEXT_INST_F(1, 0, 0);
 	    }
-	    goto gotError;
 	}
+    }
 
-	/*
-	 * 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.
-	 */
+    case INST_CALL_BUILTIN_FUNC1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	{
+	    /*
+	     * Call one of the built-in Tcl math functions.
+	     */
 
-	if (valuePtr->bytes == NULL) {
-	    TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
-	    NEXT_INST_F(1, 0, 0);
+	    BuiltinFunc *mathFuncPtr;
+
+	    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]);
+	    DECACHE_STACK_INFO();
+	    result = (*mathFuncPtr->proc)(interp, eePtr,
+	            mathFuncPtr->clientData);
+	    CACHE_STACK_INFO();
+	    if (result != TCL_OK) {
+		goto checkForCatch;
+	    }
+	    TRACE_WITH_OBJ(("%d => ", opnd), stackPtr[stackTop]);
 	}
-	if (Tcl_IsShared(valuePtr)) {
+	NEXT_INST_F(2, 0, 0);
+		    
+    case INST_CALL_FUNC1:
+	opnd = TclGetUInt1AtPtr(pc+1);
+	{
 	    /*
-	     * 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.
+	     * 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]. */
+
+	    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;
+	    }
+	    TRACE_WITH_OBJ(("%d => ", objc), stackPtr[stackTop]);
+	}
+	NEXT_INST_F(2, 0, 0);
 
-	    char *savedString = valuePtr->bytes;
+    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;
+	    } 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;
+		}
+		result = TCL_OK; /* reset the result variable */
+	    }
+	    tPtr = valuePtr->typePtr;
+	}
 
-	    valuePtr->bytes = NULL;
-	    objResultPtr = Tcl_DuplicateObj(valuePtr);
-	    valuePtr->bytes = savedString;
-	    TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr)));
+	/*
+	 * 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.
+	 */
+	
+	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;
+		}
+	    } else {
+		Tcl_InvalidateStringRep(valuePtr);
+	    }
+		
+	    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;
+		}
+	    }
+	    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)));
+	}
+	if (needNew) {
 	    NEXT_INST_F(1, 1, 1);
+	} else {
+	    NEXT_INST_F(1, 0, 0);
 	}
-	TclInvalidateStringRep(valuePtr);
-	TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr)));
-	NEXT_INST_F(1, 0, 0);
     }
-
-    /*
-     *	   End of numeric operator instructions.
-     * -----------------------------------------------------------------
-     */
-
+	
     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;
 
-    {
-	ForeachInfo *infoPtr;
-	Var *iterVarPtr, *listVarPtr;
-	Tcl_Obj *oldValuePtr, *listPtr, **elements;
-	ForeachVarList *varListPtr;
-	int numLists, iterNum, listTmpIndex, listLen, numVars;
-	int varIndex, valIndex, continueLoop, j, iterTmpIndex;
-	long i;
-
     case INST_FOREACH_START4:
-	/*
-	 * Initialize the temporary local var that holds the count of the
-	 * number of iterations of the loop body to -1.
-	 */
-
 	opnd = TclGetUInt4AtPtr(pc+1);
-	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
-	iterTmpIndex = infoPtr->loopCtTemp;
-	iterVarPtr = LOCAL(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));
+	{
+	    /*
+	     * 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;
 
+	    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));
+	}
+	    
 #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
-
+#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.
-	 */
-
 	opnd = TclGetUInt4AtPtr(pc+1);
-	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
-	numLists = infoPtr->numLists;
-
-	/*
-	 * Increment the temp holding the loop iteration number.
-	 */
-
-	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
-	valuePtr = iterVarPtr->value.objPtr;
-	iterNum = valuePtr->internalRep.longValue + 1;
-	TclSetLongObj(valuePtr, iterNum);
+	{
+	    /*
+	     * "Step" a foreach loop (i.e., begin its next iteration) by
+	     * assigning the next value list element to each loop var.
+	     */
 
-	/*
-	 * Check whether all value lists are exhausted and we should stop the
-	 * loop.
-	 */
+	    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;
 
-	continueLoop = 0;
-	listTmpIndex = infoPtr->firstValueTemp;
-	for (i = 0;  i < numLists;  i++) {
-	    varListPtr = infoPtr->varLists[i];
-	    numVars = varListPtr->numVars;
-
-	    listVarPtr = LOCAL(listTmpIndex);
-	    listPtr = listVarPtr->value.objPtr;
-	    if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
-		TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ",
-			opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp));
-		goto gotError;
-	    }
-	    if (listLen > iterNum * numVars) {
-		continueLoop = 1;
-	    }
-	    listTmpIndex++;
-	}
+	    /*
+	     * Increment the temp holding the loop iteration number.
+	     */
 
-	/*
-	 * 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.
-	 */
+	    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.
+	     */
 
-	if (continueLoop) {
+	    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;
+		}
+		if (listLen > (iterNum * numVars)) {
+		    continueLoop = 1;
+		}
+		listTmpIndex++;
+	    }
 
-		listVarPtr = LOCAL(listTmpIndex);
-		listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
-		TclListObjGetElements(interp, listPtr, &listLen, &elements);
+	    /*
+	     * 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;
 
-		valIndex = (iterNum * numVars);
-		for (j = 0;  j < numVars;  j++) {
-		    if (valIndex >= listLen) {
-			TclNewObj(valuePtr);
-		    } else {
-			valuePtr = elements[valIndex];
-		    }
+		    listVarPtr = &(compiledLocals[listTmpIndex]);
+		    listPtr = listVarPtr->value.objPtr;
 
-		    varIndex = varListPtr->varIndexes[j];
-		    varPtr = LOCAL(varIndex);
-		    while (TclIsVarLink(varPtr)) {
-			varPtr = varPtr->value.linkPtr;
-		    }
-		    if (TclIsVarDirectWritable(varPtr)) {
-			value2Ptr = varPtr->value.objPtr;
-			if (valuePtr != value2Ptr) {
-			    if (value2Ptr != NULL) {
-				TclDecrRefCount(value2Ptr);
+		    valIndex = (iterNum * numVars);
+		    for (j = 0;  j < numVars;  j++) {
+			Tcl_Obj **elements;
+
+			/*
+			 * The call to TclPtrSetVar might shimmer listPtr,
+			 * so re-fetch pointers every iteration for safety.
+			 * See test foreach-10.1.
+			 */
+
+			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);
 			    }
-			    varPtr->value.objPtr = valuePtr;
+			} else {
+			    DECACHE_STACK_INFO();
 			    Tcl_IncrRefCount(valuePtr);
-			}
-		    } else {
-			DECACHE_STACK_INFO();
-			if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
-				valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
+			    value2Ptr = TclPtrSetVar(interp, varPtr, NULL, part1, 
+						     NULL, valuePtr, TCL_LEAVE_ERR_MSG);
+			    TclDecrRefCount(valuePtr);
 			    CACHE_STACK_INFO();
-			    TRACE_WITH_OBJ((
-				    "%u => ERROR init. index temp %d: ",
-				    opnd,varIndex), Tcl_GetObjResult(interp));
-			    TclDecrRefCount(listPtr);
-			    goto gotError;
+			    if (value2Ptr == NULL) {
+				TRACE_WITH_OBJ(("%u => ERROR init. index temp %d: ",
+						opnd, varIndex),
+					       Tcl_GetObjResult(interp));
+				result = TCL_ERROR;
+				goto checkForCatch;
+			    }
 			}
-			CACHE_STACK_INFO();
+			valIndex++;
 		    }
-		    valIndex++;
+		    listTmpIndex++;
 		}
-		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.
 	 */
-
-	*(++catchTop) = CURR_DEPTH;
+	catchStackPtr[++catchTop] = stackTop;
 	TRACE(("%u => catchTop=%d, stackTop=%d\n",
-		TclGetUInt4AtPtr(pc+1), (int) (catchTop - initCatchTop - 1),
-		(int) CURR_DEPTH));
+	       TclGetUInt4AtPtr(pc+1), catchTop, stackTop));
 	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", (int) (catchTop - initCatchTop - 1)));
+	TRACE(("=> catchTop=%d\n", catchTop));
 	NEXT_INST_F(1, 0, 0);
-
+	    
     case INST_PUSH_RESULT:
 	objResultPtr = Tcl_GetObjResult(interp);
-	TRACE_WITH_OBJ(("=> "), objResultPtr);
+	TRACE_WITH_OBJ(("=> "), Tcl_GetObjResult(interp));
 
 	/*
 	 * See the comments at INST_INVOKE_STK
 	 */
+	{
+	    Tcl_Obj *newObjResultPtr;
+	    TclNewObj(newObjResultPtr);
+	    Tcl_IncrRefCount(newObjResultPtr);
+	    iPtr->objResultPtr = newObjResultPtr;
+	}
 
-	TclNewObj(objPtr);
-	Tcl_IncrRefCount(objPtr);
-	iPtr->objResultPtr = objPtr;
 	NEXT_INST_F(1, 0, -1);
 
     case INST_PUSH_RETURN_CODE:
-	TclNewIntObj(objResultPtr, result);
+	objResultPtr = Tcl_NewLongObj(result);
 	TRACE(("=> %u\n", result));
 	NEXT_INST_F(1, 0, 1);
 
-    case INST_PUSH_RETURN_OPTIONS:
-	DECACHE_STACK_INFO();
-	objResultPtr = Tcl_GetReturnOptions(interp, result);
-	CACHE_STACK_INFO();
-	TRACE_WITH_OBJ(("=> "), objResultPtr);
-	NEXT_INST_F(1, 0, 1);
-
-    case INST_RETURN_CODE_BRANCH: {
-	int code;
-
-	if (TclGetIntFromObj(NULL, OBJ_AT_TOS, &code) != TCL_OK) {
-	    Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS not a return code!");
-	}
-	if (code == TCL_OK) {
-	    Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!");
-	}
-	if (code < TCL_ERROR || code > TCL_CONTINUE) {
-	    code = TCL_CONTINUE + 1;
-	}
-	NEXT_INST_F(2*code -1, 1, 0);
-    }
-
-    /*
-     * -----------------------------------------------------------------
-     *	   Start of dictionary-related instructions.
-     */
-
-    {
-	int opnd2, allocateDict, done, i, allocdict;
-	Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr;
-	Tcl_Obj *emptyPtr, **keyPtrPtr;
-	Tcl_DictSearch *searchPtr;
-	DictUpdateInfo *duiPtr;
-
-    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));
-		goto gotError;
-	    }
-	}
-	if (Tcl_DictObjGet(interp, dictPtr, OBJ_AT_TOS,
-		&objResultPtr) == TCL_OK) {
-	    if (objResultPtr) {
-		TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-		NEXT_INST_V(5, opnd+1, 1);
-	    }
-	    DECACHE_STACK_INFO();
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "key \"", TclGetString(OBJ_AT_TOS),
-		    "\" not known in dictionary", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
-		    TclGetString(OBJ_AT_TOS), NULL);
-	    CACHE_STACK_INFO();
-	    TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp));
-	} else {
-	    TRACE_WITH_OBJ((
-		    "%u => ERROR reading leaf dictionary key \"%s\": ",
-		    opnd, O2S(dictPtr)), Tcl_GetObjResult(interp));
-	}
-	goto gotError;
-
-    case INST_DICT_SET:
-    case INST_DICT_UNSET:
-    case INST_DICT_INCR_IMM:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	opnd2 = TclGetUInt4AtPtr(pc+5);
-
-	varPtr = LOCAL(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, &valuePtr);
-	    if (result != TCL_OK) {
-		break;
-	    }
-	    if (valuePtr == NULL) {
-		Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd));
-	    } else {
-		value2Ptr = Tcl_NewIntObj(opnd);
-		Tcl_IncrRefCount(value2Ptr);
-		if (Tcl_IsShared(valuePtr)) {
-		    valuePtr = Tcl_DuplicateObj(valuePtr);
-		    Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valuePtr);
-		}
-		result = TclIncrObj(interp, valuePtr, value2Ptr);
-		if (result == TCL_OK) {
-		    TclInvalidateStringRep(dictPtr);
-		}
-		TclDecrRefCount(value2Ptr);
-	    }
-	    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) {
-		value2Ptr = varPtr->value.objPtr;
-		Tcl_IncrRefCount(dictPtr);
-		if (value2Ptr != NULL) {
-		    TclDecrRefCount(value2Ptr);
-		}
-		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))));
-		goto gotError;
-	    }
-	}
-#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 = LOCAL(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);
-	    }
-	}
-
-	if (Tcl_DictObjGet(interp, dictPtr, OBJ_UNDER_TOS,
-		&valuePtr) != TCL_OK) {
-	    if (allocateDict) {
-		TclDecrRefCount(dictPtr);
-	    }
-	    goto gotError;
-	}
-
-	/*
-	 * Note that a non-existent key results in a NULL valuePtr, 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 (valuePtr == NULL) {
-		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, OBJ_AT_TOS);
-	    } else if (Tcl_IsShared(valuePtr)) {
-		valuePtr = Tcl_DuplicateObj(valuePtr);
-		Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
-		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
-	    } else {
-		Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
-
-		/*
-		 * Must invalidate the string representation of dictionary
-		 * here because we have directly updated the internal
-		 * representation; if we don't, callers could see the wrong
-		 * string rep despite the internal version of the dictionary
-		 * having the correct value. [Bug 3079830]
-		 */
-
-		TclInvalidateStringRep(dictPtr);
-	    }
-	    break;
-	case INST_DICT_LAPPEND:
-	    /*
-	     * More complex because list-append can fail.
-	     */
-
-	    if (valuePtr == NULL) {
-		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS,
-			Tcl_NewListObj(1, &OBJ_AT_TOS));
-		break;
-	    } else if (Tcl_IsShared(valuePtr)) {
-		valuePtr = Tcl_DuplicateObj(valuePtr);
-		if (Tcl_ListObjAppendElement(interp, valuePtr,
-			OBJ_AT_TOS) != TCL_OK) {
-		    TclDecrRefCount(valuePtr);
-		    if (allocateDict) {
-			TclDecrRefCount(dictPtr);
-		    }
-		    goto gotError;
-		}
-		Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
-	    } else {
-		if (Tcl_ListObjAppendElement(interp, valuePtr,
-			OBJ_AT_TOS) != TCL_OK) {
-		    if (allocateDict) {
-			TclDecrRefCount(dictPtr);
-		    }
-		    goto gotError;
-		}
-
-		/*
-		 * Must invalidate the string representation of dictionary
-		 * here because we have directly updated the internal
-		 * representation; if we don't, callers could see the wrong
-		 * string rep despite the internal version of the dictionary
-		 * having the correct value. [Bug 3079830]
-		 */
-
-		TclInvalidateStringRep(dictPtr);
-	    }
-	    break;
-	default:
-	    Tcl_Panic("Should not happen!");
-	}
-
-	if (TclIsVarDirectWritable(varPtr)) {
-	    if (allocateDict) {
-		value2Ptr = varPtr->value.objPtr;
-		Tcl_IncrRefCount(dictPtr);
-		if (value2Ptr != NULL) {
-		    TclDecrRefCount(value2Ptr);
-		}
-		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))));
-		goto gotError;
-	    }
-	}
-#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);
-
-    case INST_DICT_FIRST:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	TRACE(("%u => ", opnd));
-	dictPtr = POP_OBJECT();
-	searchPtr = ckalloc(sizeof(Tcl_DictSearch));
-	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
-		&valuePtr, &done) != TCL_OK) {
-	    ckfree(searchPtr);
-	    goto gotError;
-	}
-	TclNewObj(statePtr);
-	statePtr->typePtr = &dictIteratorType;
-	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
-	statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
-	varPtr = LOCAL(opnd);
-	if (varPtr->value.objPtr) {
-	    if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
-		Tcl_Panic("mis-issued dictFirst!");
-	    }
-	    TclDecrRefCount(varPtr->value.objPtr);
-	}
-	varPtr->value.objPtr = statePtr;
-	Tcl_IncrRefCount(statePtr);
-	goto pushDictIteratorResult;
-
-    case INST_DICT_NEXT:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	TRACE(("%u => ", opnd));
-	statePtr = (*LOCAL(opnd)).value.objPtr;
-	if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
-	    Tcl_Panic("mis-issued dictNext!");
-	}
-	searchPtr = 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);
-	}
-
-#ifndef TCL_COMPILE_DEBUG
-	/*
-	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
-	 * followed by a conditional jump, so we can take advantage of this to
-	 * do some peephole optimization (note that we're careful to not close
-	 * out someone doing something else).
-	 */
-
-	pc += 5;
-	switch (*pc) {
-	case INST_JUMP_FALSE1:
-	    NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
-	case INST_JUMP_FALSE4:
-	    NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
-	case INST_JUMP_TRUE1:
-	    NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0);
-	case INST_JUMP_TRUE4:
-	    NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0);
-	default:
-	    pc -= 5;
-	    /* fall through to non-debug handling */
-	}
-#endif
-
-	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
-		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
-	objResultPtr = TCONST(done);
-	/* TODO: consider opt like INST_FOREACH_STEP4 */
-	NEXT_INST_F(5, 0, 1);
-
-    case INST_DICT_UPDATE_START:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	opnd2 = TclGetUInt4AtPtr(pc+5);
-	varPtr = LOCAL(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 gotError;
-	    }
-	}
-	if (TclListObjGetElements(interp, OBJ_AT_TOS, &length,
-		&keyPtrPtr) != TCL_OK) {
-	    goto gotError;
-	}
-	if (length != duiPtr->length) {
-	    Tcl_Panic("dictUpdateStart argument length mismatch");
-	}
-	for (i=0 ; i<length ; i++) {
-	    if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i],
-		    &valuePtr) != TCL_OK) {
-		goto gotError;
-	    }
-	    varPtr = LOCAL(duiPtr->varIndices[i]);
-	    while (TclIsVarLink(varPtr)) {
-		varPtr = varPtr->value.linkPtr;
-	    }
-	    DECACHE_STACK_INFO();
-	    if (valuePtr == NULL) {
-		TclObjUnsetVar2(interp,
-			localName(iPtr->varFramePtr, duiPtr->varIndices[i]),
-			NULL, 0);
-	    } else if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL,
-		    valuePtr, TCL_LEAVE_ERR_MSG,
-		    duiPtr->varIndices[i]) == NULL) {
-		CACHE_STACK_INFO();
-		goto gotError;
-	    }
-	    CACHE_STACK_INFO();
-	}
-	NEXT_INST_F(9, 0, 0);
-
-    case INST_DICT_UPDATE_END:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	opnd2 = TclGetUInt4AtPtr(pc+5);
-	varPtr = LOCAL(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) {
-	    goto gotError;
-	}
-	allocdict = Tcl_IsShared(dictPtr);
-	if (allocdict) {
-	    dictPtr = Tcl_DuplicateObj(dictPtr);
-	}
-	if (length > 0) {
-	    TclInvalidateStringRep(dictPtr);
-	}
-	for (i=0 ; i<length ; i++) {
-	    Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);
-
-	    while (TclIsVarLink(var2Ptr)) {
-		var2Ptr = var2Ptr->value.linkPtr;
-	    }
-	    if (TclIsVarDirectReadable(var2Ptr)) {
-		valuePtr = var2Ptr->value.objPtr;
-	    } else {
-		DECACHE_STACK_INFO();
-		valuePtr = TclPtrGetVar(interp, var2Ptr, NULL, NULL, NULL, 0,
-			duiPtr->varIndices[i]);
-		CACHE_STACK_INFO();
-	    }
-	    if (valuePtr == NULL) {
-		Tcl_DictObjRemove(interp, dictPtr, keyPtrPtr[i]);
-	    } else if (dictPtr == valuePtr) {
-		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i],
-			Tcl_DuplicateObj(valuePtr));
-	    } else {
-		Tcl_DictObjPut(interp, dictPtr, keyPtrPtr[i], valuePtr);
-	    }
-	}
-	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);
-		}
-		goto gotError;
-	    }
-	}
-	NEXT_INST_F(9, 1, 0);
-
-    case INST_DICT_EXPAND:
-	dictPtr = OBJ_UNDER_TOS;
-	listPtr = OBJ_AT_TOS;
-	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
-		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
-	objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv);
-	if (objResultPtr == NULL) {
-	    TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ",
-		    O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp));
-	    goto gotError;
-	}
-	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
-	NEXT_INST_F(1, 2, 1);
-
-    case INST_DICT_RECOMBINE_STK:
-	keysPtr = POP_OBJECT();
-	varNamePtr = OBJ_UNDER_TOS;
-	listPtr = OBJ_AT_TOS;
-	TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ",
-		O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr)));
-	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    TclDecrRefCount(keysPtr);
-	    goto gotError;
-	}
-	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
-		TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr);
-	if (varPtr == NULL) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    TclDecrRefCount(keysPtr);
-	    goto gotError;
-	}
-	DECACHE_STACK_INFO();
-	result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1,
-		objc, objv, keysPtr);
-	CACHE_STACK_INFO();
-	TclDecrRefCount(keysPtr);
-	if (result != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    goto gotError;
-	}
-	TRACE_APPEND(("OK\n"));
-	NEXT_INST_F(1, 2, 0);
-
-    case INST_DICT_RECOMBINE_IMM:
-	opnd = TclGetUInt4AtPtr(pc+1);
-	listPtr = OBJ_UNDER_TOS;
-	keysPtr = OBJ_AT_TOS;
-	varPtr = LOCAL(opnd);
-	TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr),
-		O2S(keysPtr)));
-	if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    goto gotError;
-	}
-	while (TclIsVarLink(varPtr)) {
-	    varPtr = varPtr->value.linkPtr;
-	}
-	DECACHE_STACK_INFO();
-	result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd,
-		objc, objv, keysPtr);
-	CACHE_STACK_INFO();
-	if (result != TCL_OK) {
-	    TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp))));
-	    goto gotError;
-	}
-	TRACE_APPEND(("OK\n"));
-	NEXT_INST_F(5, 2, 0);
-    }
-
-    /*
-     *	   End of dictionary-related instructions.
-     * -----------------------------------------------------------------
-     */
-
     default:
-	Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc);
+	panic("TclExecuteByteCode: unrecognized opCode %u", *pc);
     } /* end of switch on opCode */
 
     /*
-     * Block for variables needed to process exception returns.
+     * 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);
+    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.
      */
 
-    {
-	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. */
-	const char *bytes;
-
-	/*
-	 * 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_INVOKE_STK4:
-	    opnd = TclGetUInt4AtPtr(pc+1);
+ processExceptionReturn:
+#if TCL_COMPILE_DEBUG    
+    switch (*pc) {
+        case INST_INVOKE_STK1:
+        case INST_INVOKE_STK4:
 	    TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf));
 	    break;
-	case INST_EVAL_STK:
+        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(OBJ_AT_TOS)));
+	    TRACE(("\"%.30s\" => ", O2S(stackPtr[stackTop])));
 	    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;
 	}
-#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);
-	    }
+	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)));
+		        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));
+		   StringForResultCode(result),
+		   rangePtr->codeOffset, rangePtr->continueOffset));
 	    NEXT_INST_F(0, 0, 0);
 	}
-#if TCL_COMPILE_DEBUG
-	if (traceInstructions) {
+#if TCL_COMPILE_DEBUG    
+    } else if (traceInstructions) {
+	if ((result != TCL_ERROR) && (result != TCL_RETURN))  {
 	    objPtr = Tcl_GetObjResult(interp);
-	    if ((result != TCL_ERROR) && (result != TCL_RETURN)) {
-		TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ",
-			result, O2S(objPtr)));
-	    } else {
-		TRACE_APPEND(("%s, result= \"%s\"\n",
-			StringForResultCode(result), O2S(objPtr)));
-	    }
+	    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)));
 	}
 #endif
-	goto checkForCatch;
-
-	/*
-	 * Division by zero in an expression. Control only reaches this point
-	 * by "goto divideByZero".
-	 */
-
-    divideByZero:
-	DECACHE_STACK_INFO();
-	Tcl_SetResult(interp, "divide by zero", TCL_STATIC);
-	Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
-	CACHE_STACK_INFO();
-	goto gotError;
-
-	/*
-	 * Exponentiation of zero by negative number in an expression. Control
-	 * only reaches this point by "goto exponOfZero".
-	 */
-
-    exponOfZero:
-	DECACHE_STACK_INFO();
-	Tcl_SetResult(interp, "exponentiation of zero by negative power",
-		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
-		"exponentiation of zero by negative power", NULL);
-	CACHE_STACK_INFO();
-
-	/*
-	 * Almost all error paths feed through here rather than assigning to
-	 * result themselves (for a small but consistent saving).
-	 */
-
-    gotError:
-	result = TCL_ERROR;
-
-	/*
-	 * 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 (iPtr->execEnvPtr->rewind) {
-	    goto abnormalReturn;
-	}
-	if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
-	    const unsigned char *pcBeg;
-
-	    bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
+    }
+	    	
+    /*
+     * 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();
-	    TclLogCommandInfo(interp, codePtr->source, bytes,
-		    bytes ? length : 0, pcBeg, tosPtr);
-	    CACHE_STACK_INFO();
-	}
-	iPtr->flags &= ~ERR_ALREADY_LOGGED;
-
-	/*
-	 * Clear all expansions that may have started after the last
-	 * INST_BEGIN_CATCH.
-	 */
-
-	while (auxObjList) {
-	    if ((catchTop != initCatchTop)
-		    && (*catchTop > (ptrdiff_t)
-			auxObjList->internalRep.ptrAndLongRep.value)) {
-		break;
-	    }
-	    POP_TAUX_OBJ();
-	}
-
-	/*
-	 * We must not catch if the script in progress has been canceled with
-	 * the TCL_CANCEL_UNWIND flag. Instead, it blows outwards until we
-	 * either hit another interpreter (presumably where the script in
-	 * progress has not been canceled) or we get to the top-level. We do
-	 * NOT modify the interpreter result here because we know it will
-	 * already be set prior to vectoring down to this point in the code.
-	 */
-
-	if (TclCanceled(iPtr) && (Tcl_Canceled(interp, 0) == TCL_ERROR)) {
-#ifdef TCL_COMPILE_DEBUG
-	    if (traceInstructions) {
-		fprintf(stdout, "   ... cancel with unwind, returning %s\n",
-			StringForResultCode(result));
-	    }
-#endif
-	    goto abnormalReturn;
-	}
-
-	/*
-	 * 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
-	    goto abnormalReturn;
+	    Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
+            CACHE_STACK_INFO();
+	    iPtr->flags |= ERR_ALREADY_LOGGED;
 	}
-	if (catchTop == initCatchTop) {
+    }
+    if (catchTop == -1) {
 #ifdef TCL_COMPILE_DEBUG
-	    if (traceInstructions) {
-		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
-			StringForResultCode(result));
-	    }
-#endif
-	    goto abnormalReturn;
+	if (traceInstructions) {
+	    fprintf(stdout, "   ... no enclosing catch, returning %s\n",
+	            StringForResultCode(result));
 	}
-	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
-	     * breaking compat with previous .tbc compiled scripts.
-	     */
-
-#ifdef TCL_COMPILE_DEBUG
-	    if (traceInstructions) {
-		fprintf(stdout, "   ... no enclosing catch, returning %s\n",
-			StringForResultCode(result));
-	    }
 #endif
-	    goto abnormalReturn;
-	}
-
+	goto abnormalReturn;
+    }
+    rangePtr = GetExceptRangeForPc(pc, /*catchOnly*/ 1, codePtr);
+    if (rangePtr == NULL) {
 	/*
-	 * 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.
+	 * 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.
 	 */
-
-    processCatch:
-	while (CURR_DEPTH > *catchTop) {
-	    valuePtr = POP_OBJECT();
-	    TclDecrRefCount(valuePtr);
-	}
 #ifdef TCL_COMPILE_DEBUG
 	if (traceInstructions) {
-	    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);
+	    fprintf(stdout, "   ... no enclosing catch, returning %s\n",
+	            StringForResultCode(result));
 	}
 #endif
-	pc = (codePtr->codeStart + rangePtr->catchOffset);
-	NEXT_INST_F(0, 0, 0);	/* Restart the execution loop at pc. */
-
-	/*
-	 * end of infinite loop dispatching on instructions.
-	 */
-
-	/*
-	 * 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.
-	 */
-
-    abnormalReturn:
-	TCL_DTRACE_INST_LAST();
-
-	/*
-	 * Clear all expansions and same-level NR calls.
-	 *
-	 * Note that expansion markers have a NULL type; avoid removing other
-	 * markers.
-	 */
-
-	while (auxObjList) {
-	    POP_TAUX_OBJ();
-	}
-	while (tosPtr > initTosPtr) {
-	    objPtr = POP_OBJECT();
-	    Tcl_DecrRefCount(objPtr);
-	}
-
-	if (tosPtr < initTosPtr) {
-	    fprintf(stderr,
-		    "\nTclNRExecuteByteCode: abnormal return at pc %u: "
-		    "stack top %d < entry stack top %d\n",
-		    (unsigned)(pc - codePtr->codeStart),
-		    (unsigned) CURR_DEPTH, (unsigned) 0);
-	    Tcl_Panic("TclNRExecuteByteCode execution failure: end stack top < start stack top");
-	}
-	CLANG_ASSERT(bcFramePtr);
-    }
-
-    iPtr->cmdFramePtr = bcFramePtr->nextPtr;
-    if (--codePtr->refCount <= 0) {
-	TclCleanupByteCode(codePtr);
+	goto abnormalReturn;
     }
-    TclStackFree(interp, TD);	/* free my stack */
 
-    return result;
-}
-
-#undef codePtr
-#undef iPtr
-#undef bcFramePtr
-#undef initCatchTop
-#undef initTosPtr
-#undef auxObjList
-#undef catchTop
-#undef TCONST
-
-/*
- *----------------------------------------------------------------------
- *
- * ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
- *
- *	These functions do advanced math for binary and unary operators
- *	respectively, so that the main TEBC code does not bear the cost of
- *	them.
- *
- * Results:
- *	A Tcl_Obj* result, or a NULL (in which case valuePtr is updated to
- *	hold the result value), or one of the special flag values
- *	GENERAL_ARITHMETIC_ERROR, EXPONENT_OF_ZERO or DIVIDED_BY_ZERO. The
- *	latter two signify a zero value raised to a negative power or a value
- *	divided by zero, respectively. With GENERAL_ARITHMETIC_ERROR, all
- *	error information will have already been reported in the interpreter
- *	result.
- *
- * Side effects:
- *	May update the Tcl_Obj indicated valuePtr if it is unshared. Will
- *	return a NULL when that happens.
- *
- *----------------------------------------------------------------------
- */
+    /*
+     * 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.
+     */
 
-static Tcl_Obj *
-ExecuteExtendedBinaryMathOp(
-    Tcl_Interp *interp,		/* Where to report errors. */
-    int opcode,			/* What operation to perform. */
-    Tcl_Obj **constants,	/* The execution environment's constants. */
-    Tcl_Obj *valuePtr,		/* The first operand on the stack. */
-    Tcl_Obj *value2Ptr)		/* The second operand on the stack. */
-{
-#define LONG_RESULT(l) \
-    if (Tcl_IsShared(valuePtr)) {		\
-	TclNewLongObj(objResultPtr, l);		\
-	return objResultPtr;			\
-    } else {					\
-	Tcl_SetLongObj(valuePtr, l);		\
-	return NULL;				\
-    }
-#define WIDE_RESULT(w) \
-    if (Tcl_IsShared(valuePtr)) {		\
-	return Tcl_NewWideIntObj(w);		\
-    } else {					\
-	Tcl_SetWideIntObj(valuePtr, w);		\
-	return NULL;				\
-    }
-#define BIG_RESULT(b) \
-    if (Tcl_IsShared(valuePtr)) {		\
-	return Tcl_NewBignumObj(b);		\
-    } else {					\
-	Tcl_SetBignumObj(valuePtr, b);		\
-	return NULL;				\
-    }
-#define DOUBLE_RESULT(d) \
-    if (Tcl_IsShared(valuePtr)) {		\
-	TclNewDoubleObj(objResultPtr, (d));	\
-	return objResultPtr;			\
-    } else {					\
-	Tcl_SetDoubleObj(valuePtr, (d));	\
-	return NULL;				\
+ processCatch:
+    while (stackTop > catchStackPtr[catchTop]) {
+	valuePtr = POP_OBJECT();
+	TclDecrRefCount(valuePtr);
     }
-
-    int type1, type2;
-    ClientData ptr1, ptr2;
-    double d1, d2, dResult;
-    long l1, l2, lResult;
-    Tcl_WideInt w1, w2, wResult;
-    mp_int big1, big2, bigResult, bigRemainder;
-    Tcl_Obj *objResultPtr;
-    int invalid, numPos, zero;
-    long shift;
-
-    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
-    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
-
-    switch (opcode) {
-    case INST_MOD:
-	/* TODO: Attempts to re-use unshared operands on stack */
-
-	l2 = 0;			/* silence gcc warning */
-	if (type2 == TCL_NUMBER_LONG) {
-	    l2 = *((const long *)ptr2);
-	    if (l2 == 0) {
-		return DIVIDED_BY_ZERO;
-	    }
-	    if ((l2 == 1) || (l2 == -1)) {
-		/*
-		 * Div. by |1| always yields remainder of 0.
-		 */
-
-		return constants[0];
-	    }
-	}
-#ifndef NO_WIDE_TYPE
-	if (type1 == TCL_NUMBER_WIDE) {
-	    w1 = *((const Tcl_WideInt *)ptr1);
-	    if (type2 != TCL_NUMBER_BIG) {
-		Tcl_WideInt 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;
-		WIDE_RESULT(wRemainder);
-	    }
-
-	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-
-	    /* TODO: internals intrusion */
-	    if ((w1 > ((Tcl_WideInt) 0)) ^ (big2.sign == MP_ZPOS)) {
-		/*
-		 * Arguments are opposite sign; remainder is sum.
-		 */
-
-		TclBNInitBignumFromWideInt(&big1, w1);
-		mp_add(&big2, &big1, &big2);
-		mp_clear(&big1);
-		BIG_RESULT(&big2);
-	    }
-
-	    /*
-	     * Arguments are same sign; remainder is first operand.
-	     */
-
-	    mp_clear(&big2);
-	    return NULL;
-	}
-#endif
-	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);
-	BIG_RESULT(&bigResult);
-
-    case INST_LSHIFT:
-    case INST_RSHIFT: {
-	/*
-	 * Reject negative shift argument.
-	 */
-
-	switch (type2) {
-	case TCL_NUMBER_LONG:
-	    invalid = (*((const long *)ptr2) < 0L);
-	    break;
-#ifndef NO_WIDE_TYPE
-	case TCL_NUMBER_WIDE:
-	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
-	    break;
-#endif
-	case TCL_NUMBER_BIG:
-	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-	    invalid = (mp_cmp_d(&big2, 0) == MP_LT);
-	    mp_clear(&big2);
-	    break;
-	default:
-	    /* Unused, here to silence compiler warning */
-	    invalid = 0;
-	}
-	if (invalid) {
-	    Tcl_SetResult(interp, "negative shift argument", TCL_STATIC);
-	    return GENERAL_ARITHMETIC_ERROR;
-	}
-
-	/*
-	 * Zero shifted any number of bits is still zero.
-	 */
-
-	if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
-	    return constants[0];
-	}
-
-	if (opcode == INST_LSHIFT) {
-	    /*
-	     * 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.
-	     */
-
-	    if ((type2 != TCL_NUMBER_LONG)
-		    || (*((const long *)ptr2) > (long) INT_MAX)) {
-		/*
-		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
-		 * an mp_int, but since we're using mp_mul_2d() to do the
-		 * work, and it takes only an int argument, that's a good
-		 * place to draw the line.
-		 */
-
-		Tcl_SetResult(interp, "integer value too large to represent",
-			TCL_STATIC);
-		return GENERAL_ARITHMETIC_ERROR;
-	    }
-	    shift = (int)(*((const long *)ptr2));
-
-	    /*
-	     * Handle shifts within the native wide range.
-	     */
-
-	    if ((type1 != TCL_NUMBER_BIG)
-		    && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
-		TclGetWideIntFromObj(NULL, valuePtr, &w1);
-		if (!((w1>0 ? w1 : ~w1)
-			& -(((Tcl_WideInt)1)
-			<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
-		    WIDE_RESULT(w1 << shift);
-		}
-	    }
-	} else {
-	    /*
-	     * Quickly force large right shifts to 0 or -1.
-	     */
-
-	    if ((type2 != TCL_NUMBER_LONG)
-		    || (*(const long *)ptr2 > INT_MAX)) {
-		/*
-		 * Again, technically, the value to be shifted could be an
-		 * mp_int so huge that a right shift by (INT_MAX+1) bits could
-		 * not take us to the result of 0 or -1, but since we're using
-		 * mp_div_2d to do the work, and it takes only an int
-		 * argument, we draw the line there.
-		 */
-
-		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:
-		    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) {
-		    return constants[0];
-		}
-		LONG_RESULT(-1);
-	    }
-	    shift = (int)(*(const long *)ptr2);
-
-#ifndef NO_WIDE_TYPE
-	    /*
-	     * Handle shifts within the native wide range.
-	     */
-
-	    if (type1 == TCL_NUMBER_WIDE) {
-		w1 = *(const Tcl_WideInt *)ptr1;
-		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
-		    if (w1 >= (Tcl_WideInt)0) {
-			return constants[0];
-		    }
-		    LONG_RESULT(-1);
-		}
-		WIDE_RESULT(w1 >> shift);
-	    }
-#endif
-	}
-
-	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-
-	mp_init(&bigResult);
-	if (opcode == INST_LSHIFT) {
-	    mp_mul_2d(&big1, shift, &bigResult);
-	} else {
-	    mp_init(&bigRemainder);
-	    mp_div_2d(&big1, 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(&big1);
-	BIG_RESULT(&bigResult);
+#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 */
 
-    case INST_BITOR:
-    case INST_BITXOR:
-    case INST_BITAND:
-	if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
-	    mp_int *First, *Second;
-
-	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-
-	    /*
-	     * Count how many positive arguments we have. If only one of the
-	     * arguments is negative, store it in 'Second'.
-	     */
-
-	    if (mp_cmp_d(&big1, 0) != MP_LT) {
-		numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
-		First = &big1;
-		Second = &big2;
-	    } else {
-		First = &big2;
-		Second = &big1;
-		numPos = (mp_cmp_d(First, 0) != MP_LT);
-	    }
-	    mp_init(&bigResult);
-
-	    switch (opcode) {
-	    case INST_BITAND:
-		switch (numPos) {
-		case 2:
-		    /*
-		     * Both arguments positive, base case.
-		     */
-
-		    mp_and(First, Second, &bigResult);
-		    break;
-		case 1:
-		    /*
-		     * First is positive; second negative:
-		     * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
-		     */
-
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_xor(First, Second, &bigResult);
-		    mp_and(First, &bigResult, &bigResult);
-		    break;
-		case 0:
-		    /*
-		     * Both arguments negative:
-		     * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
-		     */
-
-		    mp_neg(First, First);
-		    mp_sub_d(First, 1, First);
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_or(First, Second, &bigResult);
-		    mp_neg(&bigResult, &bigResult);
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		    break;
-		}
-		break;
-
-	    case INST_BITOR:
-		switch (numPos) {
-		case 2:
-		    /*
-		     * Both arguments positive, base case.
-		     */
-
-		    mp_or(First, Second, &bigResult);
-		    break;
-		case 1:
-		    /*
-		     * First is positive; second negative:
-		     * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
-		     */
-
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_xor(First, Second, &bigResult);
-		    mp_and(Second, &bigResult, &bigResult);
-		    mp_neg(&bigResult, &bigResult);
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		    break;
-		case 0:
-		    /*
-		     * Both arguments negative:
-		     * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
-		     */
-
-		    mp_neg(First, First);
-		    mp_sub_d(First, 1, First);
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_and(First, Second, &bigResult);
-		    mp_neg(&bigResult, &bigResult);
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		    break;
-		}
-		break;
-
-	    case INST_BITXOR:
-		switch (numPos) {
-		case 2:
-		    /*
-		     * Both arguments positive, base case.
-		     */
-
-		    mp_xor(First, Second, &bigResult);
-		    break;
-		case 1:
-		    /*
-		     * First is positive; second negative:
-		     * P^N = ~(P^~N) = -(P^(-N-1))-1
-		     */
-
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_xor(First, Second, &bigResult);
-		    mp_neg(&bigResult, &bigResult);
-		    mp_sub_d(&bigResult, 1, &bigResult);
-		    break;
-		case 0:
-		    /*
-		     * Both arguments negative:
-		     * a ^ b = (~a ^ ~b) = (-a-1^-b-1)
-		     */
-
-		    mp_neg(First, First);
-		    mp_sub_d(First, 1, First);
-		    mp_neg(Second, Second);
-		    mp_sub_d(Second, 1, Second);
-		    mp_xor(First, Second, &bigResult);
-		    break;
-		}
-		break;
-	    }
-
-	    mp_clear(&big1);
-	    mp_clear(&big2);
-	    BIG_RESULT(&bigResult);
-	}
-
-#ifndef NO_WIDE_TYPE
-	if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
-	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
-	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
-
-	    switch (opcode) {
-	    case INST_BITAND:
-		wResult = w1 & w2;
-		break;
-	    case INST_BITOR:
-		wResult = w1 | w2;
-		break;
-	    case INST_BITXOR:
-		wResult = w1 ^ w2;
-		break;
-	    default:
-		/* Unused, here to silence compiler warning. */
-		wResult = 0;
-	    }
-	    WIDE_RESULT(wResult);
-	}
-#endif
-	l1 = *((const long *)ptr1);
-	l2 = *((const long *)ptr2);
-
-	switch (opcode) {
-	case INST_BITAND:
-	    lResult = l1 & l2;
-	    break;
-	case INST_BITOR:
-	    lResult = l1 | l2;
-	    break;
-	case INST_BITXOR:
-	    lResult = l1 ^ l2;
-	    break;
-	default:
-	    /* Unused, here to silence compiler warning. */
-	    lResult = 0;
-	}
-	LONG_RESULT(lResult);
-
-    case INST_EXPON: {
-	int oddExponent = 0, negativeExponent = 0;
-	unsigned short base;
-
-	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
-	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
-	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
-
-	    if (d1==0.0 && d2<0.0) {
-		return EXPONENT_OF_ZERO;
-	    }
-	    dResult = pow(d1, d2);
-	    goto doubleResult;
-	}
-	l1 = l2 = 0;
-	if (type2 == TCL_NUMBER_LONG) {
-	    l2 = *((const long *) ptr2);
-	    if (l2 == 0) {
-		/*
-		 * Anything to the zero power is 1.
-		 */
-
-		return constants[1];
-	    } else if (l2 == 1) {
-		/*
-		 * Anything to the first power is itself
-		 */
-
-		return NULL;
-	    }
-	}
-
-	switch (type2) {
-	case TCL_NUMBER_LONG:
-	    negativeExponent = (l2 < 0);
-	    oddExponent = (int) (l2 & 1);
-	    break;
-#ifndef NO_WIDE_TYPE
-	case TCL_NUMBER_WIDE:
-	    w2 = *((const Tcl_WideInt *)ptr2);
-	    negativeExponent = (w2 < 0);
-	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
-	    break;
-#endif
-	case TCL_NUMBER_BIG:
-	    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.
-		     */
-
-		    return EXPONENT_OF_ZERO;
-		case -1:
-		    if (oddExponent) {
-			LONG_RESULT(-1);
-		    }
-		    /* fallthrough */
-		case 1:
-		    /*
-		     * 1 to any power is 1.
-		     */
-
-		    return constants[1];
-		}
-	    }
-
-	    /*
-	     * Integers with magnitude greater than 1 raise to a negative
-	     * power yield the answer zero (see TIP 123).
-	     */
-
-	    return constants[0];
-	}
-
-	if (type1 == TCL_NUMBER_LONG) {
-	    switch (l1) {
-	    case 0:
-		/*
-		 * Zero to a positive power is zero.
-		 */
-
-		return constants[0];
-	    case 1:
-		/*
-		 * 1 to any power is 1.
-		 */
-
-		return constants[1];
-	    case -1:
-		if (!oddExponent) {
-		    return constants[1];
-		}
-		LONG_RESULT(-1);
-	    }
-	}
-
-	/*
-	 * 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_SetResult(interp, "exponent too large", TCL_STATIC);
-	    return GENERAL_ARITHMETIC_ERROR;
-	}
-
-	if (type1 == TCL_NUMBER_LONG) {
-	    if (l1 == 2) {
-		/*
-		 * Reduce small powers of 2 to shifts.
-		 */
-
-		if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
-		    LONG_RESULT(1L << l2);
-		}
-#if !defined(TCL_WIDE_INT_IS_LONG)
-		if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
-		    WIDE_RESULT(((Tcl_WideInt) 1) << l2);
-		}
-#endif
-		goto overflowExpon;
-	    }
-	    if (l1 == -2) {
-		int signum = oddExponent ? -1 : 1;
-
-		/*
-		 * Reduce small powers of 2 to shifts.
-		 */
-
-		if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
-		    LONG_RESULT(signum * (1L << l2));
-		}
-#if !defined(TCL_WIDE_INT_IS_LONG)
-		if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
-		    WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2));
-		}
-#endif
-		goto overflowExpon;
-	    }
-#if (LONG_MAX == 0x7fffffff)
-	    if (l2 - 2 < (long)MaxBase32Size
-		    && l1 <= MaxBase32[l2 - 2]
-		    && l1 >= -MaxBase32[l2 - 2]) {
-		/*
-		 * Small powers of 32-bit integers.
-		 */
-
-		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;
-		}
-		LONG_RESULT(lResult);
-	    }
-
-	    if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize
-		    && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
-		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.
-		     */
-
-		    LONG_RESULT(Exp32Value[base]);
-		}
-	    }
-	    if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
-		    && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
-		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.
-		     */
-
-		    lResult = (oddExponent) ?
-			    -Exp32Value[base] : Exp32Value[base];
-		    LONG_RESULT(lResult);
-		}
-	    }
-#endif
-	}
-#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 overflowExpon;
-	}
-	if (l2 - 2 < (long)MaxBase64Size
-		&& w1 <=  MaxBase64[l2 - 2]
-		&& w1 >= -MaxBase64[l2 - 2]) {
-	    /*
-	     * Small powers of integers whose result is wide.
-	     */
-
-	    wResult = w1 * w1;		/* b**2 */
-	    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;
-	    }
-	    WIDE_RESULT(wResult);
-	}
-
-	/*
-	 * 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)) {
-	    base = Exp64Index[w1 - 3]
-		    + (unsigned short) (l2 - 2 - MaxBase64Size);
-	    if (base < Exp64Index[w1 - 2]) {
-		/*
-		 * 64-bit number raised to intermediate power, done by
-		 * table lookup.
-		 */
-
-		WIDE_RESULT(Exp64Value[base]);
-	    }
-	}
-
-	if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
-		&& l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
-	    base = Exp64Index[-w1 - 3]
-		    + (unsigned short) (l2 - 2 - MaxBase64Size);
-	    if (base < Exp64Index[-w1 - 2]) {
-		/*
-		 * 64-bit number raised to intermediate power, done by
-		 * table lookup.
-		 */
+    /* 
+     * end of infinite loop dispatching on instructions.
+     */
 
-		wResult = oddExponent ? -Exp64Value[base] : Exp64Value[base];
-		WIDE_RESULT(wResult);
-	    }
-	}
-#endif
+    /*
+     * 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.
+     */
 
-    overflowExpon:
-	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-	if (big2.used > 1) {
-	    mp_clear(&big2);
-	    Tcl_SetResult(interp, "exponent too large", TCL_STATIC);
-	    return GENERAL_ARITHMETIC_ERROR;
-	}
-	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-	mp_init(&bigResult);
-	mp_expt_d(&big1, big2.dp[0], &bigResult);
-	mp_clear(&big1);
-	mp_clear(&big2);
-	BIG_RESULT(&bigResult);
+ abnormalReturn:
+    TCL_DTRACE_INST_LAST();
+    while (stackTop > initStackTop) {
+	valuePtr = POP_OBJECT();
+	TclDecrRefCount(valuePtr);
     }
-
-    case INST_ADD:
-    case INST_SUB:
-    case INST_MULT:
-    case INST_DIV:
-	if ((type1 == TCL_NUMBER_DOUBLE) || (type2 == TCL_NUMBER_DOUBLE)) {
-	    /*
-	     * At least one of the values is floating-point, so perform
-	     * floating point calculations.
-	     */
-
-	    Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
-	    Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
-
-	    switch (opcode) {
-	    case INST_ADD:
-		dResult = d1 + d2;
-		break;
-	    case INST_SUB:
-		dResult = d1 - d2;
-		break;
-	    case INST_MULT:
-		dResult = d1 * d2;
-		break;
-	    case INST_DIV:
-#ifndef IEEE_FLOATING_POINT
-		if (d2 == 0.0) {
-		    return DIVIDED_BY_ZERO;
-		}
-#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;
-	    default:
-		/* Unused, here to silence compiler warning. */
-		dResult = 0;
-	    }
-
-	doubleResult:
-#ifndef ACCEPT_NAN
-	    /*
-	     * Check now for IEEE floating-point error.
-	     */
-
-	    if (TclIsNaN(dResult)) {
-		TclExprFloatError(interp, dResult);
-		return GENERAL_ARITHMETIC_ERROR;
-	    }
-#endif
-	    DOUBLE_RESULT(dResult);
-	}
-	if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
-	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
-	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
-
-	    switch (opcode) {
-	    case INST_ADD:
-		wResult = w1 + w2;
-#ifndef NO_WIDE_TYPE
-		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
-#endif
-		{
-		    /*
-		     * Check for overflow.
-		     */
-
-		    if (Overflowing(w1, w2, wResult)) {
-			goto overflowBasic;
-		    }
-		}
-		break;
-
-	    case INST_SUB:
-		wResult = w1 - w2;
-#ifndef NO_WIDE_TYPE
-		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
-#endif
-		{
-		    /*
-		     * Must check for overflow. 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.
-		     */
-
-		    if (Overflowing(w1, ~w2, wResult)) {
-			goto overflowBasic;
-		    }
-		}
-		break;
-
-	    case INST_MULT:
-		if ((type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG)
-			|| (sizeof(Tcl_WideInt) < 2*sizeof(long))) {
-		    goto overflowBasic;
-		}
-		wResult = w1 * w2;
-		break;
-
-	    case INST_DIV:
-		if (w2 == 0) {
-		    return DIVIDED_BY_ZERO;
-		}
-
-		/*
-		 * Need a bignum to represent (LLONG_MIN / -1)
-		 */
-
-		if ((w1 == LLONG_MIN) && (w2 == -1)) {
-		    goto overflowBasic;
-		}
-		wResult = w1 / w2;
-
-		/*
-		 * Force Tcl's integer division rules.
-		 * TODO: examine for logic simplification
-		 */
-
-		if (((wResult < 0) || ((wResult == 0) &&
-			((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
-			(wResult*w2 != w1)) {
-		    wResult -= 1;
-		}
-		break;
-
-	    default:
-		/*
-		 * Unused, here to silence compiler warning.
-		 */
-
-		wResult = 0;
-	    }
-
-	    WIDE_RESULT(wResult);
-	}
-
-    overflowBasic:
-	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
-	Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-	mp_init(&bigResult);
-	switch (opcode) {
-	case INST_ADD:
-	    mp_add(&big1, &big2, &bigResult);
-	    break;
-	case INST_SUB:
-	    mp_sub(&big1, &big2, &bigResult);
-	    break;
-	case INST_MULT:
-	    mp_mul(&big1, &big2, &bigResult);
-	    break;
-	case INST_DIV:
-	    if (mp_iszero(&big2)) {
-		mp_clear(&big1);
-		mp_clear(&big2);
-		mp_clear(&bigResult);
-		return DIVIDED_BY_ZERO;
-	    }
-	    mp_init(&bigRemainder);
-	    mp_div(&big1, &big2, &bigResult, &bigRemainder);
-	    /* TODO: internals intrusion */
-	    if (!mp_iszero(&bigRemainder)
-		    && (bigRemainder.sign != big2.sign)) {
-		/*
-		 * Convert to Tcl's integer division rules.
-		 */
-
-		mp_sub_d(&bigResult, 1, &bigResult);
-		mp_add(&bigRemainder, &big2, &bigRemainder);
-	    }
-	    mp_clear(&bigRemainder);
-	    break;
-	}
-	mp_clear(&big1);
-	mp_clear(&big2);
-	BIG_RESULT(&bigResult);
+    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");
     }
+	
+    /*
+     * Free the catch stack array if malloc'ed storage was used.
+     */
 
-    Tcl_Panic("unexpected opcode");
-    return NULL;
-}
-
-static Tcl_Obj *
-ExecuteExtendedUnaryMathOp(
-    int opcode,			/* What operation to perform. */
-    Tcl_Obj *valuePtr)		/* The operand on the stack. */
-{
-    ClientData ptr;
-    int type;
-    Tcl_WideInt w;
-    mp_int big;
-    Tcl_Obj *objResultPtr;
-
-    (void) GetNumberFromObj(NULL, valuePtr, &ptr, &type);
-
-    switch (opcode) {
-    case INST_BITNOT:
-#ifndef NO_WIDE_TYPE
-	if (type == TCL_NUMBER_WIDE) {
-	    w = *((const Tcl_WideInt *) ptr);
-	    WIDE_RESULT(~w);
-	}
-#endif
-	Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
-	/* ~a = - a - 1 */
-	mp_neg(&big, &big);
-	mp_sub_d(&big, 1, &big);
-	BIG_RESULT(&big);
-    case INST_UMINUS:
-	switch (type) {
-	case TCL_NUMBER_DOUBLE:
-	    DOUBLE_RESULT(-(*((const double *) ptr)));
-	case TCL_NUMBER_LONG:
-	    w = (Tcl_WideInt) (*((const long *) ptr));
-	    if (w != LLONG_MIN) {
-		WIDE_RESULT(-w);
-	    }
-	    TclBNInitBignumFromLong(&big, *(const long *) ptr);
-	    break;
-#ifndef NO_WIDE_TYPE
-	case TCL_NUMBER_WIDE:
-	    w = *((const Tcl_WideInt *) ptr);
-	    if (w != LLONG_MIN) {
-		WIDE_RESULT(-w);
-	    }
-	    TclBNInitBignumFromWideInt(&big, w);
-	    break;
-#endif
-	default:
-	    Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
-	}
-	mp_neg(&big, &big);
-	BIG_RESULT(&big);
+    if (catchStackPtr != catchStackStorage) {
+	ckfree((char *) catchStackPtr);
     }
+    eePtr->stackTop = initStackTop;
 
-    Tcl_Panic("unexpected opcode");
-    return NULL;
-}
-#undef LONG_RESULT
-#undef WIDE_RESULT
-#undef BIG_RESULT
-#undef DOUBLE_RESULT
-
-/*
- *----------------------------------------------------------------------
- *
- * CompareTwoNumbers --
- *
- *	This function compares a pair of numbers in Tcl_Objs. Each argument
- *	must already be known to be numeric and not NaN.
- *
- * Results:
- *	One of MP_LT, MP_EQ or MP_GT, depending on whether valuePtr is less
- *	than, equal to, or greater than value2Ptr (respectively).
- *
- * Side effects:
- *	None, provided both values are numeric.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompareTwoNumbers(
-    Tcl_Obj *valuePtr,
-    Tcl_Obj *value2Ptr)
-{
-    int type1, type2, compare;
-    ClientData ptr1, ptr2;
-    mp_int big1, big2;
-    double d1, d2, tmp;
-    long l1, l2;
-#ifndef NO_WIDE_TYPE
-    Tcl_WideInt w1, w2;
-#endif
-
-    (void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
-    (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
-
-    switch (type1) {
-    case TCL_NUMBER_LONG:
-	l1 = *((const long *)ptr1);
-	switch (type2) {
-	case TCL_NUMBER_LONG:
-	    l2 = *((const long *)ptr2);
-	longCompare:
-	    return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
-#ifndef NO_WIDE_TYPE
-	case TCL_NUMBER_WIDE:
-	    w2 = *((const Tcl_WideInt *)ptr2);
-	    w1 = (Tcl_WideInt)l1;
-	    goto wideCompare;
-#endif
-	case TCL_NUMBER_DOUBLE:
-	    d2 = *((const double *)ptr2);
-	    d1 = (double) l1;
-
-	    /*
-	     * If the double has a fractional part, or if the long can be
-	     * converted to double without loss of precision, then compare as
-	     * doubles.
-	     */
-
-	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1
-		    || modf(d2, &tmp) != 0.0) {
-		goto doubleCompare;
-	    }
-
-	    /*
-	     * Otherwise, to make comparision based on full precision, need to
-	     * convert the double to a suitably sized integer.
-	     *
-	     * Need this to get comparsions like
-	     *	  expr 20000000000000003 < 20000000000000004.0
-	     * right. Converting the first argument to double will yield two
-	     * double values that are equivalent within double precision.
-	     * Converting the double to an integer gets done exactly, then
-	     * integer comparison can tell the difference.
-	     */
-
-	    if (d2 < (double)LONG_MIN) {
-		return MP_GT;
-	    }
-	    if (d2 > (double)LONG_MAX) {
-		return MP_LT;
-	    }
-	    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);
-	    return compare;
-	}
-
-#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:
-	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
-	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) {
-		return MP_GT;
-	    }
-	    if (d2 > (double)LLONG_MAX) {
-		return MP_LT;
-	    }
-	    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);
-	    return compare;
-	}
-#endif
-
-    case TCL_NUMBER_DOUBLE:
-	d1 = *((const double *)ptr1);
-	switch (type2) {
-	case TCL_NUMBER_DOUBLE:
-	    d2 = *((const double *)ptr2);
-	doubleCompare:
-	    return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
-	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) {
-		return MP_LT;
-	    }
-	    if (d1 > (double)LONG_MAX) {
-		return MP_GT;
-	    }
-	    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) {
-		return MP_LT;
-	    }
-	    if (d1 > (double)LLONG_MAX) {
-		return MP_GT;
-	    }
-	    w1 = (Tcl_WideInt) d1;
-	    goto wideCompare;
-#endif
-	case TCL_NUMBER_BIG:
-	    if (TclIsInfinite(d1)) {
-		return (d1 > 0.0) ? MP_GT : MP_LT;
-	    }
-	    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);
-		return compare;
-	    }
-	    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;
-	}
-
-    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);
-	    return compare;
-	case TCL_NUMBER_DOUBLE:
-	    d2 = *((const double *)ptr2);
-	    if (TclIsInfinite(d2)) {
-		compare = (d2 > 0.0) ? MP_LT : MP_GT;
-		mp_clear(&big1);
-		return compare;
-	    }
-	    if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
-		compare = mp_cmp_d(&big1, 0);
-		mp_clear(&big1);
-		return compare;
-	    }
-	    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);
-	    return compare;
-	}
-    default:
-	Tcl_Panic("unexpected number type");
-	return TCL_ERROR;
-    }
+    return result;
+#undef STATIC_CATCH_STACK_SIZE
 }
 
 #ifdef TCL_COMPILE_DEBUG
@@ -7871,9 +4537,9 @@ TclCompareTwoNumbers(
  *
  * PrintByteCodeInfo --
  *
- *	This procedure prints a summary about a bytecode object to stdout. It
- *	is called by TclNRExecuteByteCode 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.
@@ -7885,45 +4551,46 @@ TclCompareTwoNumbers(
  */
 
 static void
-PrintByteCodeInfo(
-    register ByteCode *codePtr)	/* The bytecode whose summary is printed to
-				 * stdout. */
+PrintByteCodeInfo(codePtr)
+    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%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n",
-	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
+    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,
 	    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)/codePtr->numSrcBytes :
-#endif
+	    (codePtr->numSrcBytes?
+	            ((float)codePtr->structureSize)/((float)codePtr->numSrcBytes) : 0.0));
+#else
 	    0.0);
-
+#endif
 #ifdef TCL_COMPILE_STATS
-    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)),
+    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))),
 	    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%p, refCt %d, args %d, compiled locals %d\n",
-		procPtr, procPtr->refCount, procPtr->numArgs,
-		procPtr->numCompiledLocals);
+		"  Proc 0x%x, refCt %d, args %d, compiled locals %d\n",
+		(unsigned int) procPtr, procPtr->refCount,
+		procPtr->numArgs, procPtr->numCompiledLocals);
     }
 }
 #endif /* TCL_COMPILE_DEBUG */
@@ -7933,7 +4600,7 @@ PrintByteCodeInfo(
  *
  * ValidatePcAndStackTop --
  *
- *	This procedure is called by TclNRExecuteByteCode when debugging to
+ *	This procedure is called by TclExecuteByteCode when debugging to
  *	verify that the program counter and stack top are valid during
  *	execution.
  *
@@ -7941,63 +4608,60 @@ PrintByteCodeInfo(
  *	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(
-    register ByteCode *codePtr,	/* The bytecode whose summary is printed to
-				 * stdout. */
-    const unsigned char *pc,	/* Points to first byte of a bytecode
+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
 				 * 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 checkStack)		/* 0 if the stack depth check should be
-				 * skipped. */
+    int stackLowerBound;	/* Smallest legal value for stackTop. */
 {
-    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)
+    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)
 	    (codePtr->codeStart + codePtr->numCodeBytes);
     unsigned char opCode = *pc;
 
-    if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) {
-	fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n",
-		pc);
-	Tcl_Panic("TclNRExecuteByteCode execution failure: bad 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) opCode > LAST_INST_OPCODE) {
-	fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n",
-		(unsigned) opCode, relativePc);
-	Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
+    if ((unsigned int) 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");
     }
-    if (checkStack &&
-	    ((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
+    if ((stackTop < stackLowerBound) || (stackTop > stackUpperBound)) {
 	int numChars;
-	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL);
-
-	fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min %i, max %i)",
+	char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+	char *ellipsis = "";
+	
+	fprintf(stderr, "\nBad stack top %d at pc %u in TclExecuteByteCode (min %i, max %i)",
 		stackTop, relativePc, stackLowerBound, stackUpperBound);
 	if (cmd != NULL) {
-	    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);
+	    if (numChars > 100) {
+		numChars = 100;
+		ellipsis = "...";
+	    }
+	    fprintf(stderr, "\n executing %.*s%s\n", numChars, cmd,
+		    ellipsis);
 	} else {
 	    fprintf(stderr, "\n");
 	}
-	Tcl_Panic("TclNRExecuteByteCode execution failure: bad stack top");
+	panic("TclExecuteByteCode execution failure: bad stack top");
     }
 }
 #endif /* TCL_COMPILE_DEBUG */
@@ -8007,66 +4671,142 @@ ValidatePcAndStackTop(
  *
  * IllegalExprOperandType --
  *
- *	Used by TclNRExecuteByteCode to append an error message to the interp
- *	result when an illegal operand type is detected by an expression
+ *	Used by TclExecuteByteCode to add an error message to errorInfo
+ *	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 the interp result.
+ *	An error message is appended to errorInfo.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-IllegalExprOperandType(
-    Tcl_Interp *interp,		/* Interpreter to which error information
+IllegalExprOperandType(interp, pc, opndPtr)
+    Tcl_Interp *interp;		/* Interpreter to which error information
 				 * pertains. */
-    const 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. */
 {
-    ClientData ptr;
-    int type;
-    const unsigned char opcode = *pc;
-    const char *description, *operator = operatorStrings[opcode - INST_LOR];
+    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;
 
-    if (opcode == INST_EXPON) {
-	operator = "**";
-    }
+	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;
+	    }
+	}
+
+	/*
+	 * 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 (numBytes == 0) {
-	    description = "empty string";
-	} else if (TclCheckBadOctal(NULL, bytes)) {
-	    description = "invalid octal number";
+	    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);
+	    }
 	} else {
-	    description = "non-numeric string";
+	    /*
+	     * 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";
+	    }
 	}
-    } 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";
+      makeErrorMessage:
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
+		msg, " as operand of \"", operatorStrings[opCode - INST_LOR],
+		"\"", (char *) NULL);
     }
-
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "can't use %s as operand of \"%s\"", description, operator));
-    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclGetSrcInfoForPc, GetSrcInfoForPc, TclGetSrcInfoForCmd --
+ * TclGetSrcInfoForPc, GetSrcInfoForPc --
  *
  *	Given a program counter value, finds the closest command in the
  *	bytecode code unit's CmdLocation array and returns information about
@@ -8076,101 +4816,85 @@ IllegalExprOperandType(
  * 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:
- *	The CmdFrame at *cfPtr is updated.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-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, NULL);
-}
-
+#ifdef TCL_TIP280
 void
-TclGetSrcInfoForPc(
-    CmdFrame *cfPtr)
+TclGetSrcInfoForPc (cfPtr)
+     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, NULL);
+        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, i;
-	Interp *iPtr = (Interp *) *codePtr->interpHandle;
-	Tcl_HashEntry *hePtr =
-		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
+	ExtCmdLoc*     eclPtr;
+	ECL*           locPtr = NULL;
+	int            srcOffset;
 
-	if (!hePtr) {
-	    return;
-	}
+        Interp*        iPtr  = (Interp*) *codePtr->interpHandle;
+	Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
+
+	if (!hePtr) return;
 
 	srcOffset = cfPtr->cmd.str.cmd - codePtr->source;
-	eclPtr = Tcl_GetHashValue(hePtr);
+	eclPtr    = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
 
-	for (i=0; i < eclPtr->nuloc; i++) {
-	    if (eclPtr->loc[i].srcOffset == srcOffset) {
-		locPtr = eclPtr->loc+i;
-		break;
+	{
+	    int i;
+	    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");
-	}
 
-	cfPtr->line = locPtr->line;
-	cfPtr->nline = locPtr->nline;
-	cfPtr->type = eclPtr->type;
+	if (locPtr == NULL) {Tcl_Panic ("LocSearch failure");}
+
+	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 const char *
-GetSrcInfoForPc(
-    const unsigned char *pc,	/* The program counter value for which to
+static char *
+GetSrcInfoForPc(pc, codePtr, lengthPtr)
+    unsigned char *pc;		/* The program counter value for which to
 				 * return the closest command's source info.
-				 * This points within a bytecode instruction
+				 * 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. */
-    const unsigned char **pcBeg)/* If non-NULL, the bytecode location
-				 * where the current instruction starts.
-				 * If NULL; no pointer is stored. */
+    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;
@@ -8182,7 +4906,6 @@ GetSrcInfoForPc(
     int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
 
     if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
-	if (pcBeg != NULL) *pcBeg = NULL;
 	return NULL;
     }
 
@@ -8194,11 +4917,11 @@ GetSrcInfoForPc(
 
     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) *codeDeltaNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*codeDeltaNext) == (unsigned int) 0xFF) {
 	    codeDeltaNext++;
 	    delta = TclGetInt4AtPtr(codeDeltaNext);
 	    codeDeltaNext += 4;
@@ -8208,7 +4931,7 @@ GetSrcInfoForPc(
 	}
 	codeOffset += delta;
 
-	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*codeLengthNext) == (unsigned int) 0xFF) {
 	    codeLengthNext++;
 	    codeLen = TclGetInt4AtPtr(codeLengthNext);
 	    codeLengthNext += 4;
@@ -8218,7 +4941,7 @@ GetSrcInfoForPc(
 	}
 	codeEnd = (codeOffset + codeLen - 1);
 
-	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*srcDeltaNext) == (unsigned int) 0xFF) {
 	    srcDeltaNext++;
 	    delta = TclGetInt4AtPtr(srcDeltaNext);
 	    srcDeltaNext += 4;
@@ -8228,7 +4951,7 @@ GetSrcInfoForPc(
 	}
 	srcOffset += delta;
 
-	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+	if ((unsigned int) (*srcLengthNext) == (unsigned int) 0xFF) {
 	    srcLengthNext++;
 	    srcLen = TclGetInt4AtPtr(srcLengthNext);
 	    srcLengthNext += 4;
@@ -8236,13 +4959,11 @@ GetSrcInfoForPc(
 	    srcLen = TclGetInt1AtPtr(srcLengthNext);
 	    srcLengthNext++;
 	}
-
-	if (codeOffset > pcOffset) {	/* Best cmd already found */
+	
+	if (codeOffset > pcOffset) {      /* best cmd already found */
 	    break;
-	}
-	if (pcOffset <= codeEnd) {	/* This cmd's code encloses pc */
+	} else if (pcOffset <= codeEnd) { /* this cmd's code encloses pc */
 	    int dist = (pcOffset - codeOffset);
-
 	    if (dist <= bestDist) {
 		bestDist = dist;
 		bestSrcOffset = srcOffset;
@@ -8251,31 +4972,13 @@ GetSrcInfoForPc(
 	}
     }
 
-    if (pcBeg != NULL) {
-	const unsigned char *curr, *prev;
-
-	/*
-	 * Walk from beginning of command or BC to pc, by complete
-	 * instructions. Stop when crossing pc; keep previous.
-	 */
-
-	curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
-	prev = curr;
-	while (curr <= pc) {
-	    prev = curr;
-	    curr += tclInstructionTable[*curr].numBytes;
-	}
-	*pcBeg = prev;
-    }
-
     if (bestDist == INT_MAX) {
 	return NULL;
     }
-
+    
     if (lengthPtr != NULL) {
 	*lengthPtr = bestSrcLength;
     }
-
     return (codePtr->source + bestSrcOffset);
 }
 
@@ -8288,14 +4991,15 @@ GetSrcInfoForPc(
  *	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.
@@ -8304,32 +5008,33 @@ GetSrcInfoForPc(
  */
 
 static ExceptionRange *
-GetExceptRangeForPc(
-    const unsigned char *pc, /* The program counter value for which to
+GetExceptRangeForPc(pc, catchOnly, codePtr)
+    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;
@@ -8337,7 +5042,7 @@ GetExceptRangeForPc(
     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;
@@ -8352,9 +5057,9 @@ GetExceptRangeForPc(
  *
  * GetOpcodeName --
  *
- *	This procedure is called by the TRACE and TRACE_WITH_OBJ macros used
- *	in TclNRExecuteByteCode 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.
@@ -8366,13 +5071,13 @@ GetExceptRangeForPc(
  */
 
 #ifdef TCL_COMPILE_DEBUG
-static const char *
-GetOpcodeName(
-    const unsigned char *pc)	/* Points to the instruction whose name should
-				 * be returned. */
+static char *
+GetOpcodeName(pc)
+    unsigned char *pc;		/* Points to the instruction whose name
+				 * should be returned. */
 {
     unsigned char opCode = *pc;
-
+    
     return tclInstructionTable[opCode].name;
 }
 #endif /* TCL_COMPILE_DEBUG */
@@ -8380,10 +5085,988 @@ GetOpcodeName(
 /*
  *----------------------------------------------------------------------
  *
+ * 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);
+	} 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.
@@ -8395,34 +6078,34 @@ GetOpcodeName(
  */
 
 void
-TclExprFloatError(
-    Tcl_Interp *interp,		/* Where to store error message. */
-    double value)		/* Value returned after error; used to
+TclExprFloatError(interp, value)
+    Tcl_Interp *interp;		/* Where to store error message. */
+    double value;		/* Value returned after error;  used to
 				 * distinguish underflows from overflows. */
 {
-    const char *s;
+    char *s;
 
-    if ((errno == EDOM) || TclIsNaN(value)) {
+    Tcl_ResetResult(interp);
+    if ((errno == EDOM) || IS_NAN(value)) {
 	s = "domain error: argument not in valid range";
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
-    } else if ((errno == ERANGE) || TclIsInfinite(value)) {
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *) NULL);
+    } else if ((errno == ERANGE) || IS_INF(value)) {
 	if (value == 0.0) {
 	    s = "floating-point value too small to represent";
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *) NULL);
 	} else {
 	    s = "floating-point value too large to represent";
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
+	    Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
+	    Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *) NULL);
 	}
     } else {
-	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);
+	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);
     }
 }
 
@@ -8436,8 +6119,8 @@ TclExprFloatError(
  *	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.
@@ -8446,9 +6129,9 @@ TclExprFloatError(
  */
 
 int
-TclLog2(
-    register int value)		/* The integer for which to compute the log
-				 * base 2. */
+TclLog2(value)
+    register int value;		/* The integer for which to compute the
+				 * log base 2. */
 {
     register int n = value;
     register int result = 0;
@@ -8478,15 +6161,15 @@ TclLog2(
  */
 
 static int
-EvalStatsCmd(
-    ClientData unused,		/* Unused. */
-    Tcl_Interp *interp,		/* The current interpreter. */
-    int objc,			/* The number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument strings. */
+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. */
 {
     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;
@@ -8498,18 +6181,12 @@ EvalStatsCmd(
     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)
@@ -8522,7 +6199,7 @@ EvalStatsCmd(
     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));
@@ -8530,93 +6207,94 @@ EvalStatsCmd(
 	    + iPtr->literalTable.numEntries * sizeof(Tcl_Obj)
 	    + statsPtr->currentLitStringBytes;
     currentCodeBytes = statsPtr->currentByteCodeBytes + currentLiteralBytes;
-
+    
     /*
      * Summary statistics, total and current source and ByteCode sizes.
      */
 
-    Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n");
-    Tcl_AppendPrintfToObj(objPtr,
-	    "Compilation and execution statistics for interpreter %#lx\n",
-	    (long int)iPtr);
+    fprintf(stdout, "\n----------------------------------------------------------------\n");
+    fprintf(stdout,
+	    "Compilation and execution statistics for interpreter 0x%x\n",
+	    (unsigned int) iPtr);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n",
+    fprintf(stdout, "\nNumber ByteCodes executed	%ld\n",
 	    statsPtr->numExecutions);
-    Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n",
+    fprintf(stdout, "Number ByteCodes compiled	%ld\n",
 	    statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean executions/compile\t%.1f\n",
-	    statsPtr->numExecutions / (float)statsPtr->numCompilations);
-
-    Tcl_AppendPrintfToObj(objPtr, "\nInstructions executed\t\t%.0f\n",
+    fprintf(stdout, "  Mean executions/compile	%.1f\n",
+	    ((float)statsPtr->numExecutions) / ((float)statsPtr->numCompilations));
+    
+    fprintf(stdout, "\nInstructions executed		%.0f\n",
 	    numInstructions);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/compile\t\t%.0f\n",
+    fprintf(stdout, "  Mean inst/compile		%.0f\n",
 	    numInstructions / statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean inst/execution\t\t%.0f\n",
+    fprintf(stdout, "  Mean inst/execution		%.0f\n",
 	    numInstructions / statsPtr->numExecutions);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n",
+    fprintf(stdout, "\nTotal ByteCodes			%ld\n",
 	    statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
+    fprintf(stdout, "  Source bytes			%.6g\n",
 	    statsPtr->totalSrcBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
+    fprintf(stdout, "  Code bytes			%.6g\n",
 	    totalCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
+    fprintf(stdout, "    ByteCode bytes		%.6g\n",
 	    statsPtr->totalByteCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
+    fprintf(stdout, "    Literal bytes		%.6g\n",
 	    totalLiteralBytes);
-    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)),
+    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),
 	    statsPtr->totalLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean code/compile\t\t%.1f\n",
+    fprintf(stdout, "  Mean code/compile		%.1f\n",
 	    totalCodeBytes / statsPtr->numCompilations);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
+    fprintf(stdout, "  Mean code/source		%.1f\n",
 	    totalCodeBytes / statsPtr->totalSrcBytes);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n",
+    fprintf(stdout, "\nCurrent (active) ByteCodes	%ld\n",
 	    numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "  Source bytes\t\t\t%.6g\n",
+    fprintf(stdout, "  Source bytes			%.6g\n",
 	    statsPtr->currentSrcBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Code bytes\t\t\t%.6g\n",
+    fprintf(stdout, "  Code bytes			%.6g\n",
 	    currentCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    ByteCode bytes\t\t%.6g\n",
+    fprintf(stdout, "    ByteCode bytes		%.6g\n",
 	    statsPtr->currentByteCodeBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    Literal bytes\t\t%.6g\n",
+    fprintf(stdout, "    Literal bytes		%.6g\n",
 	    currentLiteralBytes);
-    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)),
+    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),
 	    statsPtr->currentLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean code/source\t\t%.1f\n",
+    fprintf(stdout, "  Mean code/source		%.1f\n",
 	    currentCodeBytes / statsPtr->currentSrcBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Code + source bytes\t\t%.6g (%0.1f mean code/src)\n",
+    fprintf(stdout, "  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;
-    Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n");
-    Tcl_AppendPrintfToObj(objPtr, "  Object had refcount <=1 (not shared)\t%ld\n",
+    fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
+    fprintf(stdout, "  Object had refcount <=1 (not shared)	%ld\n",
 	    tclObjsShared[1]);
     for (i = 2;  i < TCL_MAX_SHARED_OBJ_STATS;  i++) {
-	Tcl_AppendPrintfToObj(objPtr, "  refcount ==%d\t\t%ld\n",
+	fprintf(stdout, "  refcount ==%d		%ld\n",
 		i, tclObjsShared[i]);
 	numSharedMultX += tclObjsShared[i];
     }
-    Tcl_AppendPrintfToObj(objPtr, "  refcount >=%d\t\t%ld\n",
+    fprintf(stdout, "  refcount >=%d		%ld\n",
 	    i, tclObjsShared[0]);
     numSharedMultX += tclObjsShared[0];
-    Tcl_AppendPrintfToObj(objPtr, "  Total shared objects\t\t\t%d\n",
+    fprintf(stdout, "  Total shared objects			%d\n",
 	    numSharedMultX);
 
     /*
@@ -8626,14 +6304,14 @@ EvalStatsCmd(
     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++;
 	    }
@@ -8653,230 +6331,213 @@ EvalStatsCmd(
     sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared)
 	    - currentLiteralBytes;
 
-    Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n",
+    fprintf(stdout, "\nTotal objects (all interps)	%ld\n",
 	    tclObjsAlloced);
-    Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n",
+    fprintf(stdout, "Current objects			%ld\n",
 	    (tclObjsAlloced - tclObjsFreed));
-    Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n",
+    fprintf(stdout, "Total literal objects		%ld\n",
 	    statsPtr->numLiteralsCreated);
 
-    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n",
+    fprintf(stdout, "\nCurrent literal objects		%d (%0.1f%% of current objects)\n",
 	    globalTablePtr->numEntries,
-	    Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed));
-    Tcl_AppendPrintfToObj(objPtr, "  ByteCode literals\t\t%ld (%0.1f%% of current literals)\n",
+	    (globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
+    fprintf(stdout, "  ByteCode literals	 	%ld (%0.1f%% of current literals)\n",
 	    numByteCodeLits,
-	    Percent(numByteCodeLits, globalTablePtr->numEntries));
-    Tcl_AppendPrintfToObj(objPtr, "  Literals reused > 1x\t\t%d\n",
+	    (numByteCodeLits * 100.0) / globalTablePtr->numEntries);
+    fprintf(stdout, "  Literals reused > 1x	 	%d\n",
 	    numSharedMultX);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean reference count\t\t%.2f\n",
+    fprintf(stdout, "  Mean reference count	 	%.2f\n",
 	    ((double) refCountSum) / globalTablePtr->numEntries);
-    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str reused >1x \t%.2f\n",
-	    (numSharedMultX ? strBytesSharedMultX/numSharedMultX : 0.0));
-    Tcl_AppendPrintfToObj(objPtr, "  Mean len, str used 1x\t\t%.2f\n",
-	    (numSharedOnce ? strBytesSharedOnce/numSharedOnce : 0.0));
-    Tcl_AppendPrintfToObj(objPtr, "  Total sharing savings\t\t%.6g (%0.1f%% of bytes if no sharing)\n",
+    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",
 	    sharingBytesSaved,
-	    Percent(sharingBytesSaved, objBytesIfUnshared+strBytesIfUnshared));
-    Tcl_AppendPrintfToObj(objPtr, "    Bytes with sharing\t\t%.6g\n",
+	    (sharingBytesSaved * 100.0) / (objBytesIfUnshared + strBytesIfUnshared));
+    fprintf(stdout, "    Bytes with sharing		%.6g\n",
 	    currentLiteralBytes);
-    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)),
+    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),
 	    statsPtr->currentLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "    Bytes if no sharing\t\t%.6g = objects %.6g + strings %.6g\n",
+    fprintf(stdout, "    Bytes if no sharing		%.6g = objects %.6g + strings %.6g\n",
 	    (objBytesIfUnshared + strBytesIfUnshared),
 	    objBytesIfUnshared, strBytesIfUnshared);
-    Tcl_AppendPrintfToObj(objPtr, "  String sharing savings \t%.6g = unshared %.6g - shared %.6g\n",
+    fprintf(stdout, "  String sharing savings 	%.6g = unshared %.6g - shared %.6g\n",
 	    (strBytesIfUnshared - statsPtr->currentLitStringBytes),
 	    strBytesIfUnshared, statsPtr->currentLitStringBytes);
-    Tcl_AppendPrintfToObj(objPtr, "  Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n",
+    fprintf(stdout, "  Literal mgmt overhead	 	%ld (%0.1f%% of bytes with sharing)\n",
 	    literalMgmtBytes,
-	    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)));
+	    (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));
 
     /*
      * Breakdown of current ByteCode space requirements.
      */
-
-    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",
+    
+    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",
 	    statsPtr->currentByteCodeBytes,
 	    statsPtr->currentByteCodeBytes / numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "Header            %12.6g   %8.1f%%   %8.1f\n",
+    fprintf(stdout, "Header            %12.6g   %8.1f%%   %8.1f\n",
 	    currentHeaderBytes,
-	    Percent(currentHeaderBytes, statsPtr->currentByteCodeBytes),
+	    ((currentHeaderBytes * 100.0) / statsPtr->currentByteCodeBytes),
 	    currentHeaderBytes / numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "Instructions      %12.6g   %8.1f%%   %8.1f\n",
+    fprintf(stdout, "Instructions      %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentInstBytes,
-	    Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes),
+	    ((statsPtr->currentInstBytes * 100.0) / statsPtr->currentByteCodeBytes),
 	    statsPtr->currentInstBytes / numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g   %8.1f%%   %8.1f\n",
+    fprintf(stdout, "Literal ptr array %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentLitBytes,
-	    Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes),
+	    ((statsPtr->currentLitBytes * 100.0) / statsPtr->currentByteCodeBytes),
 	    statsPtr->currentLitBytes / numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "Exception table   %12.6g   %8.1f%%   %8.1f\n",
+    fprintf(stdout, "Exception table   %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentExceptBytes,
-	    Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes),
+	    ((statsPtr->currentExceptBytes * 100.0) / statsPtr->currentByteCodeBytes),
 	    statsPtr->currentExceptBytes / numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "Auxiliary data    %12.6g   %8.1f%%   %8.1f\n",
+    fprintf(stdout, "Auxiliary data    %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentAuxBytes,
-	    Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes),
+	    ((statsPtr->currentAuxBytes * 100.0) / statsPtr->currentByteCodeBytes),
 	    statsPtr->currentAuxBytes / numCurrentByteCodes);
-    Tcl_AppendPrintfToObj(objPtr, "Command map       %12.6g   %8.1f%%   %8.1f\n",
+    fprintf(stdout, "Command map       %12.6g   %8.1f%%   %8.1f\n",
 	    statsPtr->currentCmdMapBytes,
-	    Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes),
+	    ((statsPtr->currentCmdMapBytes * 100.0) / statsPtr->currentByteCodeBytes),
 	    statsPtr->currentCmdMapBytes / numCurrentByteCodes);
 
     /*
      * Detailed literal statistics.
      */
-
-    Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n");
-    Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n");
+    
+    fprintf(stdout, "\nLiteral string sizes:\n");
+    fprintf(stdout, "	 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];
-	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
-		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
+        fprintf(stdout,	"	%10d		%8.0f%%\n",
+		decadeHigh, (sum * 100.0) / statsPtr->numLiteralsCreated);
     }
 
     litTableStats = TclLiteralStats(globalTablePtr);
-    Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal table statistics:\n%s\n",
-	    litTableStats);
-    ckfree(litTableStats);
+    fprintf(stdout, "\nCurrent literal table statistics:\n%s\n",
+            litTableStats);
+    ckfree((char *) litTableStats);
 
     /*
      * Source and ByteCode size distributions.
      */
 
-    Tcl_AppendPrintfToObj(objPtr, "\nSource sizes:\n");
-    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
+    fprintf(stdout, "\nSource sizes:\n");
+    fprintf(stdout, "	 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];
-	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
-		decadeHigh, Percent(sum, statsPtr->numCompilations));
+        fprintf(stdout,	"	%10d		%8.0f%%\n",
+		decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
     }
 
-    Tcl_AppendPrintfToObj(objPtr, "\nByteCode sizes:\n");
-    Tcl_AppendPrintfToObj(objPtr, "\t Up to size\t\tPercentage\n");
+    fprintf(stdout, "\nByteCode sizes:\n");
+    fprintf(stdout, "	 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];
-	Tcl_AppendPrintfToObj(objPtr, "\t%10d\t\t%8.0f%%\n",
-		decadeHigh, Percent(sum, statsPtr->numCompilations));
+        fprintf(stdout,	"	%10d		%8.0f%%\n",
+		decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
     }
 
-    Tcl_AppendPrintfToObj(objPtr, "\nByteCode longevity (excludes Current ByteCodes):\n");
-    Tcl_AppendPrintfToObj(objPtr, "\t       Up to ms\t\tPercentage\n");
+    fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
+    fprintf(stdout, "	       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];
-	Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
-		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
+        fprintf(stdout,	"	%12.3f		%8.0f%%\n",
+		decadeHigh / 1000.0,
+		(sum * 100.0) / statsPtr->numByteCodesFreed);
     }
 
     /*
      * Instruction counts.
      */
 
-    Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
+    fprintf(stdout, "\nInstruction counts:\n");
     for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
-	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");
-	}
+        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");
+    for (i = 0;  i <= LAST_INST_OPCODE;  i++) {
+        if (statsPtr->instructionCount[i] == 0) {
+            fprintf(stdout, "%20s\n", tclInstructionTable[i].name);
+        }
     }
 
 #ifdef TCL_MEM_DEBUG
-    Tcl_AppendPrintfToObj(objPtr, "\nHeap Statistics:\n");
-    TclDumpMemoryInfo((ClientData) objPtr, 1);
+    fprintf(stdout, "\nHeap Statistics:\n");
+    TclDumpMemoryInfo(stdout);
 #endif
-    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);
+    fprintf(stdout, "\n----------------------------------------------------------------\n");
     return TCL_OK;
 }
 #endif /* TCL_COMPILE_STATS */
@@ -8887,15 +6548,15 @@ EvalStatsCmd(
  *
  * 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.
@@ -8903,13 +6564,13 @@ EvalStatsCmd(
  *----------------------------------------------------------------------
  */
 
-static const char *
-StringForResultCode(
-    int result)			/* The Tcl result code for which to generate a
-				 * string. */
+static CONST char *
+StringForResultCode(result)
+    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];
     }
@@ -8925,3 +6586,4 @@ StringForResultCode(
  * fill-column: 78
  * End:
  */
+
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index a868fe3..3d6a169 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1,13 +1,13 @@
 /*
  * 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
@@ -15,31 +15,33 @@
 #   define _USE_32BIT_TIME_T
 #endif
 
+#include <sys/stat.h>
 #include "tclInt.h"
-#include "tclFileSystem.h"
+#include "tclPort.h"
 
 /*
- * Declarations for local functions defined in this file:
+ * Declarations for local procedures defined in this file:
  */
 
-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);
+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));
 
 /*
  *---------------------------------------------------------------------------
  *
  * TclFileRenameCmd
  *
- *	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.
+ *	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.
  *
  * Results:
  *	A standard Tcl result.
@@ -51,12 +53,10 @@ static int		FileForceOption(Tcl_Interp *interp,
  */
 
 int
-TclFileRenameCmd(
-    ClientData clientData,	/* Unused */
-    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. */
+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. */
 {
     return FileCopyRename(interp, objc, objv, 0);
 }
@@ -66,9 +66,10 @@ TclFileRenameCmd(
  *
  * TclFileCopyCmd
  *
- *	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.
+ *	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.
  *
  * Results:
  *	A standard Tcl result.
@@ -80,12 +81,10 @@ TclFileRenameCmd(
  */
 
 int
-TclFileCopyCmd(
-    ClientData clientData,	/* Unused */
-    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. */
+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. */
 {
     return FileCopyRename(interp, objc, objv, 1);
 }
@@ -95,8 +94,8 @@ TclFileCopyCmd(
  *
  * FileCopyRename --
  *
- *	Performs the work of TclFileRenameCmd and TclFileCopyCmd. See
- *	comments for those functions.
+ *	Performs the work of TclFileRenameCmd and TclFileCopyCmd.
+ *	See comments for those procedures.
  *
  * Results:
  *	See above.
@@ -108,31 +107,34 @@ TclFileCopyCmd(
  */
 
 static int
-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,
+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,
 				 * rename them. */
 {
     int i, result, force;
-    Tcl_StatBuf statBuf;
+    Tcl_StatBuf statBuf; 
     Tcl_Obj *target;
 
-    i = FileForceOption(interp, objc - 1, objv + 1, &force);
+    i = FileForceOption(interp, objc - 2, objv + 2, &force);
     if (i < 0) {
 	return TCL_ERROR;
     }
-    i++;
+    i += 2;
     if ((objc - i) < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, 
-		"?-option value ...? source ?source ...? target");
+	Tcl_AppendResult(interp, "wrong # args: should be \"", 
+		Tcl_GetString(objv[0]), " ", Tcl_GetString(objv[1]), 
+		" ?options? source ?source ...? target\"", 
+		(char *) NULL);
 	return TCL_ERROR;
     }
 
     /*
-     * If target doesn't exist or isn't a directory, try the copy/rename. More
-     * than 2 arguments is only valid if the target is an existing directory.
+     * If target doesn't exist or isn't a directory, try the copy/rename.
+     * More than 2 arguments is only valid if the target is an existing
+     * directory.
      */
 
     target = objv[objc - 1];
@@ -153,14 +155,15 @@ FileCopyRename(
 	    errno = ENOTDIR;
 	    Tcl_PosixError(interp);
 	    Tcl_AppendResult(interp, "error ",
-		    (copyFlag ? "copying" : "renaming"), ": target \"",
-		    TclGetString(target), "\" is not a directory", NULL);
+		    ((copyFlag) ? "copying" : "renaming"), ": target \"",
+		    Tcl_GetString(target), "\" is not a directory", 
+		    (char *) 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,
@@ -168,16 +171,17 @@ FileCopyRename(
 	}
 	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;
@@ -185,11 +189,13 @@ FileCopyRename(
 	}
 	jargv[0] = objv[objc - 1];
 	jargv[1] = source;
-	newFileName = TclJoinPath(2, jargv);
+	temp = Tcl_NewListObj(2, jargv);
+	newFileName = Tcl_FSJoinPath(temp, -1);
 	Tcl_IncrRefCount(newFileName);
 	result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
 		force);
 	Tcl_DecrRefCount(newFileName);
+	Tcl_DecrRefCount(temp);
 	Tcl_DecrRefCount(source);
 
 	if (result == TCL_ERROR) {
@@ -204,9 +210,10 @@ FileCopyRename(
  *
  * TclFileMakeDirsCmd
  *
- *	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.
+ *	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.
  *
  * Results:
  *	A standard Tcl result.
@@ -216,29 +223,28 @@ FileCopyRename(
  *
  *----------------------------------------------------------------------
  */
-
 int
-TclFileMakeDirsCmd(
-    ClientData clientData,	/* Unused */
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    int objc,			/* Number of arguments */
-    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
+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. */
 {
-    Tcl_Obj *errfile = NULL;
+    Tcl_Obj *errfile;
     int result, i, j, pobjc;
     Tcl_Obj *split = NULL;
     Tcl_Obj *target = NULL;
     Tcl_StatBuf statBuf;
 
+    errfile = NULL;
+
     result = TCL_OK;
-    for (i = 1; i < objc; i++) {
+    for (i = 2; i < objc; i++) {
 	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
 	    result = TCL_ERROR;
 	    break;
 	}
 
-	split = Tcl_FSSplitPath(objv[i], &pobjc);
-	Tcl_IncrRefCount(split);
+	split = Tcl_FSSplitPath(objv[i],&pobjc);
 	if (pobjc == 0) {
 	    errno = ENOENT;
 	    errfile = objv[i];
@@ -247,10 +253,10 @@ TclFileMakeDirsCmd(
 	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) {
@@ -261,40 +267,36 @@ TclFileMakeDirsCmd(
 		}
 	    } 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) {
-		    errfile = target;
-		    goto done;
-		} else 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.
-		     */
-
-		    Tcl_ResetResult(interp);
+		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.
+			 */
+			Tcl_ResetResult(interp);
+		    } else {
+			errfile = target;
+			goto done;
+		    }
 		} else {
 		    errfile = target;
 		    goto done;
 		}
 	    }
-
-	    /*
-	     * Forget about this sub-path.
-	     */
-
+ 	    /* Forget about this sub-path */
 	    Tcl_DecrRefCount(target);
 	    target = NULL;
 	}
@@ -302,10 +304,11 @@ TclFileMakeDirsCmd(
 	split = NULL;
     }
 
-  done:
+    done:
     if (errfile != NULL) {
 	Tcl_AppendResult(interp, "can't create directory \"",
-		TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
+		Tcl_GetString(errfile), "\": ", Tcl_PosixError(interp), 
+		(char *) NULL);
 	result = TCL_ERROR;
     }
     if (split != NULL) {
@@ -322,8 +325,8 @@ TclFileMakeDirsCmd(
  *
  * TclFileDeleteCmd
  *
- *	This function implements the "delete" subcommand of the "file"
- *	command.
+ *	This procedure implements the "delete" subcommand of the "file"
+ *      command.
  *
  * Results:
  *	A standard Tcl result.
@@ -335,25 +338,31 @@ TclFileMakeDirsCmd(
  */
 
 int
-TclFileDeleteCmd(
-    ClientData clientData,	/* Unused */
-    Tcl_Interp *interp,		/* Used for error reporting */
-    int objc,			/* Number of arguments */
-    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
+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. */
 {
     int i, force, result;
     Tcl_Obj *errfile;
     Tcl_Obj *errorBuffer = NULL;
-
-    i = FileForceOption(interp, objc - 1, objv + 1, &force);
+    
+    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);
+	return TCL_ERROR;
+    }
 
     errfile = NULL;
     result = TCL_OK;
 
-    for (i++ ; i < objc; i++) {
+    for ( ; i < objc; i++) {
 	Tcl_StatBuf statBuf;
 
 	errfile = objv[i];
@@ -368,39 +377,34 @@ TclFileDeleteCmd(
 
 	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 \"",
-			    TclGetString(objv[i]), "\": directory not empty",
-			    NULL);
+		    Tcl_AppendResult(interp, "error deleting \"", 
+			    Tcl_GetString(objv[i]),
+			    "\": directory not empty", (char *) 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];
 		}
@@ -408,34 +412,32 @@ TclFileDeleteCmd(
 	} 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), NULL);
+	    Tcl_AppendResult(interp, "error deleting unknown file: ", 
+		    Tcl_PosixError(interp), (char *) NULL);
 	} else {
-	    Tcl_AppendResult(interp, "error deleting \"",
-		    TclGetString(errfile), "\": ", Tcl_PosixError(interp),
-		    NULL);
+	    Tcl_AppendResult(interp, "error deleting \"", 
+		    Tcl_GetString(errfile), "\": ", 
+		    Tcl_PosixError(interp), (char *) NULL);
 	}
-    }
-
-  done:
+    } 
+    done:
     if (errorBuffer != NULL) {
 	Tcl_DecrRefCount(errorBuffer);
     }
@@ -447,37 +449,37 @@ TclFileDeleteCmd(
  *
  * 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(
-    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(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
 				 * exists. */
 {
     int result;
     Tcl_Obj *errfile, *errorBuffer;
-    Tcl_Obj *actualSource=NULL;	/* If source is a link, then this is the real
-				 * file/directory. */
+    /* If source is a link, then this is the real file/directory */
+    Tcl_Obj *actualSource = NULL;
     Tcl_StatBuf sourceStatBuf, targetStatBuf;
 
     if (Tcl_FSConvertToPathType(interp, source) != TCL_OK) {
@@ -486,15 +488,16 @@ CopyRenameOneFile(
     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) {
@@ -530,48 +533,30 @@ CopyRenameOneFile(
 	}
 #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 \"",
-		    TclGetString(target), "\" with directory \"",
-		    TclGetString(source), "\"", NULL);
+	    Tcl_AppendResult(interp, "can't overwrite file \"", 
+		    Tcl_GetString(target), "\" with directory \"", 
+		    Tcl_GetString(source), "\"", (char *) 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 \"",
-		    TclGetString(target), "\" with file \"",
-		    TclGetString(source), "\"", NULL);
+	    Tcl_AppendResult(interp, "can't overwrite directory \"", 
+		    Tcl_GetString(target), "\" with file \"", 
+		    Tcl_GetString(source), "\"", (char *) 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) {
@@ -579,95 +564,62 @@ CopyRenameOneFile(
 	if (result == TCL_OK) {
 	    goto done;
 	}
-
+	    
 	if (errno == EINVAL) {
-	    Tcl_AppendResult(interp, "error renaming \"",
-		    TclGetString(source), "\" to \"", TclGetString(target),
-		    "\": trying to rename a volume or "
-		    "move a directory into itself", NULL);
+	    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);
 	    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 \"", TclGetString(source),
-		    "\": the target of this link doesn't exist", NULL);
+	    /* Actual file doesn't exist */
+	    Tcl_AppendResult(interp, 
+		    "error copying \"", Tcl_GetString(source), 
+		    "\": the target of this link doesn't exist",
+		    (char *) 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;
@@ -676,43 +628,47 @@ CopyRenameOneFile(
 	    /* Now 'actualSource' is the correct file */
 	}
     }
-#endif /* S_ISLNK */
+#endif
 #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_Obj *copyCommand, *cmdObj, *opObj;
-
-		TclNewObj(copyCommand);
-		TclNewLiteralStringObj(cmdObj, "::tcl::CopyDirectory");
-		Tcl_ListObjAppendElement(interp, copyCommand, cmdObj);
+		Tcl_SavedResult savedResult;
+		Tcl_Obj *copyCommand = Tcl_NewListObj(0,NULL);
+		Tcl_IncrRefCount(copyCommand);
+		Tcl_ListObjAppendElement(interp, copyCommand, 
+			Tcl_NewStringObj("::tcl::CopyDirectory",-1));
 		if (copyFlag) {
-		    TclNewLiteralStringObj(opObj, "copying");
+		    Tcl_ListObjAppendElement(interp, copyCommand, 
+					     Tcl_NewStringObj("copying",-1));
 		} else {
-		    TclNewLiteralStringObj(opObj, "renaming");
+		    Tcl_ListObjAppendElement(interp, copyCommand, 
+					     Tcl_NewStringObj("renaming",-1));
 		}
-		Tcl_ListObjAppendElement(interp, copyCommand, opObj);
 		Tcl_ListObjAppendElement(interp, copyCommand, source);
 		Tcl_ListObjAppendElement(interp, copyCommand, target);
-		Tcl_IncrRefCount(copyCommand);
-		result = Tcl_EvalObjEx(interp, copyCommand,
-			TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
+		Tcl_SaveResult(interp, &savedResult);
+		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;
@@ -729,22 +685,19 @@ CopyRenameOneFile(
 	    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);
 	}
     }
@@ -752,7 +705,6 @@ CopyRenameOneFile(
 	if (S_ISDIR(sourceStatBuf.st_mode)) {
 	    result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
 	    if (result != TCL_OK) {
-		errfile = errorBuffer;
 		if (Tcl_FSEqualPaths(errfile, source) == 0) {
 		    errfile = source;
 		}
@@ -764,26 +716,31 @@ CopyRenameOneFile(
 	    }
 	}
 	if (result != TCL_OK) {
-	    Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
-		    "\": ", Tcl_PosixError(interp), NULL);
+	    Tcl_AppendResult(interp, "can't unlink \"", 
+		Tcl_GetString(errfile), "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
 	    errfile = NULL;
 	}
     }
-
-  done:
+    
+    done:
     if (errfile != NULL) {
-	Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
-		 " \"", TclGetString(source), NULL);
+	Tcl_AppendResult(interp, 
+		((copyFlag) ? "error copying \"" : "error renaming \""),
+		 Tcl_GetString(source), (char *) NULL);
 	if (errfile != source) {
-	    Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
+	    Tcl_AppendResult(interp, "\" to \"", Tcl_GetString(target), 
+			     (char *) NULL);
 	    if (errfile != target) {
-		Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
+		Tcl_AppendResult(interp, "\": \"", Tcl_GetString(errfile), 
+				 (char *) NULL);
 	    }
 	}
-	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
+	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp),
+		(char *) NULL);
     }
     if (errorBuffer != NULL) {
-	Tcl_DecrRefCount(errorBuffer);
+        Tcl_DecrRefCount(errorBuffer);
     }
     if (actualSource != NULL) {
 	Tcl_DecrRefCount(actualSource);
@@ -796,13 +753,14 @@ CopyRenameOneFile(
  *
  * 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.
@@ -811,33 +769,30 @@ CopyRenameOneFile(
  */
 
 static int
-FileForceOption(
-    Tcl_Interp *interp,		/* Interp, for error return. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[],	/* Argument strings.  First command line
+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
 				 * 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, idx;
-    static const char *const options[] = {
-	"-force", "--", NULL
-    };
-
+    int force, i;
+    
     force = 0;
     for (i = 0; i < objc; i++) {
-	if (TclGetString(objv[i])[0] != '-') {
+	if (Tcl_GetString(objv[i])[0] != '-') {
 	    break;
 	}
-	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
-		&idx) != TCL_OK) {
-	    return -1;
-	}
-	if (idx == 0 /* -force */) {
+	if (strcmp(Tcl_GetString(objv[i]), "-force") == 0) {
 	    force = 1;
-	} else { /* -- */
+	} else if (strcmp(Tcl_GetString(objv[i]), "--") == 0) {
 	    i++;
 	    break;
+	} else {
+	    Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[i]), 
+		    "\": should be -force or --", (char *)NULL);
+	    return -1;
 	}
     }
     *forcePtr = force;
@@ -850,12 +805,13 @@ FileForceOption(
  *
  *	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.
@@ -864,25 +820,23 @@ FileForceOption(
  */
 
 static Tcl_Obj *
-FileBasename(
-    Tcl_Interp *interp,		/* Interp, for error return. */
-    Tcl_Obj *pathPtr)		/* Path whose basename to extract. */
+FileBasename(interp, pathPtr)
+    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) && (*TclGetString(pathPtr) == '~')) {
+	if ((objc == 1) && (*Tcl_GetString(pathPtr) == '~')) {
 	    Tcl_DecrRefCount(splitPtr);
 	    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
 		return NULL;
 	    }
 	    splitPtr = Tcl_FSSplitPath(pathPtr, &objc);
-	    Tcl_IncrRefCount(splitPtr);
 	}
 
 	/*
@@ -893,7 +847,7 @@ FileBasename(
 	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;
 	    }
 	}
@@ -911,157 +865,117 @@ FileBasename(
  *
  * 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.
- *	    const char *fileName;   This is extracted using
+ *      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(
-    ClientData clientData,	/* Unused */
-    Tcl_Interp *interp,		/* The interpreter for error reporting. */
-    int objc,			/* Number of command line arguments. */
-    Tcl_Obj *const objv[])	/* The command line objects. */
+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. */
 {
     int result;
-    const char *const *attributeStrings;
-    const char **attributeStringsAllocated = NULL;
-    Tcl_Obj *objStrings = NULL;
+    CONST char ** attributeStrings;
+    Tcl_Obj* objStrings = NULL;
     int numObjStrings = -1;
     Tcl_Obj *filePtr;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
+    
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 2, objv,
+		"name ?option? ?value? ?option value ...?");
 	return TCL_ERROR;
     }
 
-    filePtr = objv[1];
+    filePtr = objv[2];
     if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
-	return TCL_ERROR;
+    	return TCL_ERROR;
     }
-
-    objc -= 2;
-    objv += 2;
+    
+    objc -= 3;
+    objv += 3;
     result = TCL_ERROR;
     Tcl_SetErrno(0);
-
-    /*
-     * Get the set of attribute names from the filesystem.
-     */
-
     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_AppendResult(interp, "could not read \"",
-			TclGetString(filePtr), "\": ", Tcl_PosixError(interp),
-			NULL);
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
+			"could not read \"", Tcl_GetString(filePtr), 
+			"\": ", Tcl_PosixError(interp), 
+			(char *) NULL);
+		return TCL_ERROR;
 	    }
-	    return TCL_ERROR;
+	    goto end;
 	}
-
-	/*
-	 * 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;
 	}
-	attributeStringsAllocated = (const char **)
-		TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
+	attributeStrings = (CONST char **)
+		ckalloc ((1+numObjStrings) * sizeof(char*));
 	for (index = 0; index < numObjStrings; index++) {
 	    Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
-	    attributeStringsAllocated[index] = TclGetString(objPtr);
+	    attributeStrings[index] = Tcl_GetString(objPtr);
 	}
-	attributeStringsAllocated[index] = NULL;
-	attributeStrings = attributeStringsAllocated;
-    } else if (objStrings != NULL) {
-	Tcl_Panic("must not update objPtrRef's variable and return non-NULL");
+	attributeStrings[index] = NULL;
     }
-
-    /*
-     * Process the attributes to produce a list of all of them, the value of a
-     * particular attribute, or to set one or more attributes (depending on
-     * the number of arguments).
-     */
-
     if (objc == 0) {
 	/*
 	 * Get all attributes.
 	 */
 
-	int index, res = TCL_OK, nbAtts = 0;
+	int index;
 	Tcl_Obj *listPtr;
-
+	 
 	listPtr = Tcl_NewListObj(0, NULL);
 	for (index = 0; attributeStrings[index] != NULL; index++) {
-	    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_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_ListObjAppendElement(interp, listPtr, objPtr);
 	}
-
-	if (index > 0 && nbAtts == 0) {
-	    /*
-	     * Error: no valid attributes found.
-	     */
-
-	    Tcl_DecrRefCount(listPtr);
-	    goto end;
-	}
-
-	Tcl_SetObjResult(interp, listPtr);
+    	Tcl_SetObjResult(interp, listPtr);
     } else if (objc == 1) {
 	/*
 	 * Get one attribute.
@@ -1071,10 +985,9 @@ TclFileAttrsCmd(
 	Tcl_Obj *objPtr = NULL;
 
 	if (numObjStrings == 0) {
-	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
-		    "\", there are no file attributes in this filesystem.",
-		    NULL);
-	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
+	    Tcl_AppendResult(interp, "bad option \"",
+		    Tcl_GetString(objv[0]), "\", there are no file attributes"
+			     " in this filesystem.", (char *) NULL);
 	    goto end;
 	}
 
@@ -1082,8 +995,10 @@ TclFileAttrsCmd(
 		"option", 0, &index) != TCL_OK) {
 	    goto end;
 	}
-	if (attributeStringsAllocated != NULL) {
-	    TclFreeIntRep(objv[0]);
+	if (numObjStrings != -1 && objv[0]->typePtr != NULL
+		&& objv[0]->typePtr->freeIntRepProc != NULL) {
+	    objv[0]->typePtr->freeIntRepProc(objv[0]);
+	    objv[0]->typePtr = NULL;
 	}
 	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
 		&objPtr) != TCL_OK) {
@@ -1096,417 +1011,49 @@ TclFileAttrsCmd(
 	 */
 
 	int i, index;
-
+        
 	if (numObjStrings == 0) {
-	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
-		    "\", there are no file attributes in this filesystem.",
-		    NULL);
-	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
+	    Tcl_AppendResult(interp, "bad option \"",
+		    Tcl_GetString(objv[0]), "\", there are no file attributes"
+			     " in this filesystem.", (char *) NULL);
 	    goto end;
 	}
 
-	for (i = 0; i < objc ; i += 2) {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
+    	for (i = 0; i < objc ; i += 2) {
+    	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
 		    "option", 0, &index) != TCL_OK) {
 		goto end;
-	    }
-	    if (attributeStringsAllocated != NULL) {
-		TclFreeIntRep(objv[i]);
+    	    }
+	    if (numObjStrings != -1 && objv[i]->typePtr != NULL
+		    && objv[i]->typePtr->freeIntRepProc != NULL) {
+		objv[i]->typePtr->freeIntRepProc(objv[i]);
+		objv[i]->typePtr = NULL;
 	    }
 	    if (i + 1 == objc) {
 		Tcl_AppendResult(interp, "value for \"",
-			TclGetString(objv[i]), "\" missing", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
-			"NOVALUE", NULL);
+			Tcl_GetString(objv[i]), "\" missing",
+			(char *) NULL);
 		goto end;
 	    }
-	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
-		    objv[i + 1]) != TCL_OK) {
+    	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
+    	    	    objv[i + 1]) != TCL_OK) {
 		goto end;
-	    }
-	}
+    	    }
+    	}
     }
     result = TCL_OK;
 
-    /*
-     * Free up the array we allocated and drop our reference to any list of
-     * attribute names issued by the filesystem.
-     */
-
-  end:
-    if (attributeStringsAllocated != NULL) {
-	TclStackFree(interp, (void *) attributeStringsAllocated);
-    }
-    if (objStrings != NULL) {
-	Tcl_DecrRefCount(objStrings);
-    }
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFileLinkCmd --
- *
- *	This function is invoked to process the "file link" Tcl command. See
- *	the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May create a new link.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclFileLinkCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *contents;
-    int index;
-
-    if (objc < 2 || objc > 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Index of the 'source' argument.
-     */
-
-    if (objc == 4) {
-	index = 2;
-    } else {
-	index = 1;
-    }
-
-    if (objc > 2) {
-	int linkAction;
-
-	if (objc == 4) {
-	    /*
-	     * We have a '-linktype' argument.
-	     */
-
-	    static const char *const linkTypes[] = {
-		"-symbolic", "-hard", NULL
-	    };
-	    if (Tcl_GetIndexFromObj(interp, objv[1], 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) {
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Create link from source to target.
-	 */
-
-	contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
-	if (contents == NULL) {
-	    /*
-	     * We handle three 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 \"",
-			TclGetString(objv[index]),
-			"\": that path already exists", NULL);
-		Tcl_PosixError(interp);
-	    } 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);
-		    Tcl_PosixError(interp);
-		} else {
-		    Tcl_AppendResult(interp, "could not create new link \"",
-			    TclGetString(objv[index]), "\": target \"",
-			    TclGetString(objv[index+1]), "\" doesn't exist",
-			    NULL);
-		    errno = ENOENT;
-		    Tcl_PosixError(interp);
-		}
-	    } else {
-		Tcl_AppendResult(interp, "could not create new link \"",
-			TclGetString(objv[index]), "\" pointing to \"",
-			TclGetString(objv[index+1]), "\": ",
-			Tcl_PosixError(interp), NULL);
-	    }
-	    return TCL_ERROR;
-	}
-    } 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 \"",
-		    TclGetString(objv[index]), "\": ", Tcl_PosixError(interp),
-		    NULL);
-	    return TCL_ERROR;
-	}
-    }
-    Tcl_SetObjResult(interp, contents);
-    if (objc == 2) {
-	/*
-	 * 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFileReadLinkCmd --
- *
- *	This function is invoked to process the "file readlink" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclFileReadLinkCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *contents;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
-    }
-
-    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    contents = Tcl_FSLink(objv[1], NULL, 0);
-
-    if (contents == NULL) {
-	Tcl_AppendResult(interp, "could not readlink \"",
-		TclGetString(objv[1]), "\": ", Tcl_PosixError(interp), NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, contents);
-    Tcl_DecrRefCount(contents);
-    return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFileTemporaryCmd
- *
- *	This function implements the "tempfile" subcommand of the "file"
- *	command.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	Creates a temporary file. Opens a channel to that file and puts the
- *	name of that channel in the result. *Might* register suitable exit
- *	handlers to ensure that the temporary file gets deleted. Might write
- *	to a variable, so reentrancy is a potential issue.
- *
- *---------------------------------------------------------------------------
- */
-
-int
-TclFileTemporaryCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_Obj *nameVarObj = NULL;	/* Variable to store the name of the temporary
-				 * file in. */
-    Tcl_Obj *nameObj = NULL;	/* Object that will contain the filename. */
-    Tcl_Channel chan;		/* The channel opened (RDWR) on the temporary
-				 * file, or NULL if there's an error. */
-    Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
-				/* Pieces of template. Each piece is NULL if
-				 * it is omitted. The platform temporary file
-				 * engine might ignore some pieces. */
-
-    if (objc < 1 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
-	return TCL_ERROR;
-    }
-
-    if (objc > 1) {
-	nameVarObj = objv[1];
-	TclNewObj(nameObj);
-    }
-    if (objc > 2) {
-	int length;
-	Tcl_Obj *templateObj = objv[2];
-	const char *string = TclGetStringFromObj(templateObj, &length);
-
-	/*
-	 * Treat an empty string as if it wasn't there.
+    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.
 	 */
-
-	if (length == 0) {
-	    goto makeTemporary;
+	if (objStrings != NULL) {
+	    Tcl_DecrRefCount(objStrings);
 	}
-
-	/*
-	 * The template only gives a directory if there is a directory
-	 * separator in it.
-	 */
-
-	if (strchr(string, '/') != NULL
-		|| (tclPlatform == TCL_PLATFORM_WINDOWS
-		    && strchr(string, '\\') != NULL)) {
-	    tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
-
-	    /*
-	     * Only allow creation of temporary files in the native filesystem
-	     * since they are frequently used for integration with external
-	     * tools or system libraries. [Bug 2388866]
-	     */
-
-	    if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
-		    != &tclNativeFilesystem) {
-		TclDecrRefCount(tempDirObj);
-		tempDirObj = NULL;
-	    }
-	}
-
-	/*
-	 * The template only gives the filename if the last character isn't a
-	 * directory separator.
-	 */
-
-	if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
-		|| string[length-1] != '\\')) {
-	    Tcl_Obj *tailObj = TclPathPart(interp, templateObj,
-		    TCL_PATH_TAIL);
-
-	    if (tailObj != NULL) {
-		tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
-		tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
-		TclDecrRefCount(tailObj);
-	    }
-	}
-    }
-
-    /*
-     * Convert empty parts of the template into unspecified parts.
-     */
-
-    if (tempDirObj && !TclGetString(tempDirObj)[0]) {
-	TclDecrRefCount(tempDirObj);
-	tempDirObj = NULL;
-    }
-    if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
-	TclDecrRefCount(tempBaseObj);
-	tempBaseObj = NULL;
-    }
-    if (tempExtObj && !TclGetString(tempExtObj)[0]) {
-	TclDecrRefCount(tempExtObj);
-	tempExtObj = NULL;
     }
-
-    /*
-     * Create and open the temporary file.
-     */
-
-  makeTemporary:
-    chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
-
-    /*
-     * If we created pieces of template, get rid of them now.
-     */
-
-    if (tempDirObj) {
-	TclDecrRefCount(tempDirObj);
-    }
-    if (tempBaseObj) {
-	TclDecrRefCount(tempBaseObj);
-    }
-    if (tempExtObj) {
-	TclDecrRefCount(tempExtObj);
-    }
-
-    /*
-     * Deal with results.
-     */
-
-    if (chan == NULL) {
-	if (nameVarObj) {
-	    TclDecrRefCount(nameObj);
-	}
-	Tcl_AppendResult(interp, "can't create temporary file: ",
-		Tcl_PosixError(interp), NULL);
-	return TCL_ERROR;
-    }
-    Tcl_RegisterChannel(interp, chan);
-    if (nameVarObj != NULL) {
-	if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
-		TCL_LEAVE_ERR_MSG) == NULL) {
-	    Tcl_UnregisterChannel(interp, chan);
-	    return TCL_ERROR;
-	}
-    }
-    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
-    return TCL_OK;
+    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 5048308..761c8be 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1,95 +1,153 @@
-/*
+/* 
  * 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() */
 
+/* 
+ * This define is used to activate Tcl's interpretation of Unix-style
+ * paths (containing forward slashes, '.' and '..') on MacOS.  A 
+ * side-effect of this is that some paths become ambiguous.
+ */
+#define MAC_UNDERSTANDS_UNIX_PATHS
+
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
 /*
- * The following variable is set in the TclPlatformInit call to one of:
- * TCL_PLATFORM_UNIX or TCL_PLATFORM_WINDOWS.
+ * The following regular expression matches the root portion of a Macintosh
+ * absolute path.  It will match degenerate Unix-style paths, tilde paths,
+ * Unix-style paths, and Mac paths.  The various subexpressions in this
+ * can be summarised as follows: ^(/..|~user/unix|~user:mac|/unix|mac:dir).
+ * The subexpression indices which match the root portions, are as follows:
+ * 
+ * degenerate unix-style: 2
+ * unix-tilde: 5
+ * mac-tilde: 7
+ * unix-style: 9 (or 10 to cut off the irrelevant header).
+ * mac: 12
+ * 
  */
 
-TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
+#define MAC_ROOT_PATTERN "^((/+([.][.]?/+)*([.][.]?)?)|(~[^:/]*)(/[^:]*)?|(~[^:]*)(:.*)?|/+([.][.]?/+)*([^:/]+)(/[^:]*)?|([^:]+):.*)$"
 
 /*
- * Prototypes for local procedures defined in this file:
+ * The following variables are used to hold precompiled regular expressions
+ * for use in filename matching.
  */
 
-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);
+typedef struct ThreadSpecificData {
+    int initialized;
+    Tcl_Obj *macRootPatternPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+static void		FileNameCleanup _ANSI_ARGS_((ClientData clientData));
+static void		FileNameInit _ANSI_ARGS_((void));
+
+#endif
 
 /*
- * When there is no support for getting the block size of a file in a stat()
- * call, use this as a guess. Allow it to be overridden in the platform-
- * specific files.
+ * The following variable is set in the TclPlatformInit call to one
+ * of: TCL_PLATFORM_UNIX, TCL_PLATFORM_MAC, or TCL_PLATFORM_WINDOWS.
  */
 
-#if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE))
-#define GUESSED_BLOCK_SIZE	1024
-#endif
+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*		SplitMacPath _ANSI_ARGS_((CONST char *path));
+static Tcl_Obj*		SplitWinPath _ANSI_ARGS_((CONST char *path));
+static Tcl_Obj*		SplitUnixPath _ANSI_ARGS_((CONST char *path));
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
 
 /*
  *----------------------------------------------------------------------
  *
- * SetResultLength --
+ * FileNameInit --
  *
- *	Resets the result DString for ExtractWinRoot to accommodate
- *	any NT extended path prefixes.
+ *	This procedure initializes the patterns used by this module.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	May modify the Tcl_DString.
+ *	Compiles the regular expressions.
+ *
  *----------------------------------------------------------------------
  */
 
 static void
-SetResultLength(
-    Tcl_DString *resultPtr,
-    int offset,
-    int extended)
+FileNameInit()
 {
-    Tcl_DStringSetLength(resultPtr, offset);
-    if (extended == 2) {
-	Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
-    } else if (extended == 1) {
-	Tcl_DStringAppend(resultPtr, "//?/", 4);
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    if (!tsdPtr->initialized) {
+	tsdPtr->initialized = 1;
+	tsdPtr->macRootPatternPtr = Tcl_NewStringObj(MAC_ROOT_PATTERN, -1);
+	Tcl_CreateThreadExitHandler(FileNameCleanup, NULL);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ExtractWinRoot --
+ * FileNameCleanup --
+ *
+ *	This procedure is a Tcl_ExitProc used to clean up the static
+ *	data structures used in this file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Deallocates storage used by the procedures in this file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FileNameCleanup(clientData)
+    ClientData clientData;	/* Not used. */
+{
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
+    tsdPtr->initialized = 0;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
  *
- *	Matches the root portion of a Windows path and appends it to the
- *	specified Tcl_DString.
+ * ExtractWinRoot --
  *
+ *	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.
@@ -97,88 +155,59 @@ SetResultLength(
  *----------------------------------------------------------------------
  */
 
-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
+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
 				 * 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] != '\\') {
-	    SetResultLength(resultPtr, offset, extended);
+	    Tcl_DStringSetLength(resultPtr, offset);
 	    *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];
 	}
-	SetResultLength(resultPtr, offset, extended);
+	Tcl_DStringSetLength(resultPtr, offset);
 	share = &host[hlen];
 
-	/*
-	 * Skip separators.
-	 */
+	/* Skip separators */
+	while (share[0] == '/' || share[0] == '\\') share++;
 
-	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);
@@ -187,37 +216,24 @@ ExtractWinRoot(
 
 	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 separator.
-	 */
-
-	SetResultLength(resultPtr, offset, extended);
+	/* Might be a drive sep */
+	Tcl_DStringSetLength(resultPtr, offset);
 
 	if (path[2] != '/' && path[2] != '\\') {
 	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
 	    Tcl_DStringAppend(resultPtr, path, 2);
 	    return &path[2];
 	} else {
-	    const char *tail = &path[3];
-
-	    /*
-	     * Skip separators.
-	     */
+	    char *tail = (char*)&path[3];
 
-	    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);
@@ -227,90 +243,58 @@ ExtractWinRoot(
 	}
     } else {
 	int abs = 0;
-
-	/*
-	 * Check for Windows devices.
-	 */
-
-	if ((path[0] == 'c' || path[0] == 'C')
-		&& (path[1] == 'o' || path[1] == 'O')) {
+	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;
-	    SetResultLength(resultPtr, offset, extended);
+	    Tcl_DStringSetLength(resultPtr, offset);
 	    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;
 }
@@ -320,12 +304,12 @@ ExtractWinRoot(
  *
  * 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
@@ -338,12 +322,11 @@ ExtractWinRoot(
  */
 
 Tcl_PathType
-Tcl_GetPathType(
-    const char *path)
+Tcl_GetPathType(path)
+    CONST char *path;
 {
     Tcl_PathType type;
     Tcl_Obj *tempObj = Tcl_NewStringObj(path,-1);
-
     Tcl_IncrRefCount(tempObj);
     type = Tcl_FSGetPathType(tempObj);
     Tcl_DecrRefCount(tempObj);
@@ -355,18 +338,12 @@ Tcl_GetPathType(
  *
  * 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.
- *
- *	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.
+ *	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.
  *
  * Results:
  *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
@@ -379,24 +356,22 @@ Tcl_GetPathType(
  */
 
 Tcl_PathType
-TclpGetNativePathType(
-    Tcl_Obj *pathPtr,		/* Native path of interest */
-    int *driveNameLengthPtr,	/* Returns length of drive, if non-NULL and
-				 * path was absolute */
-    Tcl_Obj **driveNameRef)
+TclpGetNativePathType(pathObjPtr, driveNameLengthPtr, driveNameRef)
+    Tcl_Obj *pathObjPtr;
+    int *driveNameLengthPtr;
+    Tcl_Obj **driveNameRef;
 {
     Tcl_PathType type = TCL_PATH_ABSOLUTE;
     int pathLen;
-    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
-
+    char *path = Tcl_GetStringFromObj(pathObjPtr, &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) {
-	    const char *end = path + 1;
+	    char *end = path + 1;
 	    while ((*end != '\0') && (*end != '/')) {
 		end++;
 	    }
@@ -404,54 +379,137 @@ TclpGetNativePathType(
 	}
     } else {
 	switch (tclPlatform) {
-	case TCL_PLATFORM_UNIX: {
-	    const char *origPath = path;
-
-	    /*
-	     * Paths that begin with / are absolute.
-	     */
+	    case TCL_PLATFORM_UNIX: {
+		char *origPath = path;
+	        
+		/*
+		 * Paths that begin with / are absolute.
+		 */
 
 #ifdef __QNX__
-	    /*
-	     * Check for QNX //<node id> prefix
-	     */
-	    if (*path && (pathLen > 3) && (path[0] == '/')
-		    && (path[1] == '/') && isdigit(UCHAR(path[2]))) {
-		path += 3;
-		while (isdigit(UCHAR(*path))) {
-		    path++;
+		/*
+		 * Check for QNX //<node id> prefix
+		 */
+		if (*path && (pathLen > 3) && (path[0] == '/') 
+		  && (path[1] == '/') && isdigit(UCHAR(path[2]))) {
+		    path += 3;
+		    while (isdigit(UCHAR(*path))) {
+			++path;
+		    }
 		}
-	    }
 #endif
-	    if (path[0] == '/') {
-		if (driveNameLengthPtr != NULL) {
+		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;
+		}
+		break;
+	    }
+	    case TCL_PLATFORM_MAC:
+		if (path[0] == ':') {
+		    type = TCL_PATH_RELATIVE;
+		} else {
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+		    ThreadSpecificData *tsdPtr;
+		    Tcl_RegExp re;
+
+		    tsdPtr = TCL_TSD_INIT(&dataKey);
+
 		    /*
-		     * We need this addition in case the QNX code was used.
+		     * Since we have eliminated the easy cases, use the
+		     * root pattern to look for the other types.
 		     */
 
-		    *driveNameLengthPtr = (1 + path - origPath);
+		    FileNameInit();
+		    re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr,
+			    REG_ADVANCED);
+
+		    if (!Tcl_RegExpExec(NULL, re, path, path)) {
+			type = TCL_PATH_RELATIVE;
+		    } else {
+			CONST char *root, *end;
+			Tcl_RegExpRange(re, 2, &root, &end);
+			if (root != NULL) {
+			    type = TCL_PATH_RELATIVE;
+			} else {
+			    if (driveNameLengthPtr != NULL) {
+				Tcl_RegExpRange(re, 0, &root, &end);
+				*driveNameLengthPtr = end - root;
+			    }
+			    if (driveNameRef != NULL) {
+				if (*root == '/') {
+				    char *c;
+				    int gotColon = 0;
+				    *driveNameRef = Tcl_NewStringObj(root + 1,
+					    end - root -1);
+				    c = Tcl_GetString(*driveNameRef);
+				    while (*c != '\0') {
+					if (*c == '/') {
+					    gotColon++;
+					    *c = ':';
+					}
+					c++;
+				    }
+				    /* 
+				     * If there is no colon, we have just a
+				     * volume name so we must add a colon so
+				     * it is an absolute path.
+				     */
+				    if (gotColon == 0) {
+				        Tcl_AppendToObj(*driveNameRef, ":", 1);
+				    } else if ((gotColon > 1) &&
+					    (*(c-1) == ':')) {
+					/* We have an extra colon */
+				        Tcl_SetObjLength(*driveNameRef, 
+					  c - Tcl_GetString(*driveNameRef) - 1);
+				    }
+				}
+			    }
+			}
+		    }
+#else
+		    if (path[0] == '~') {
+		    } else if (path[0] == ':') {
+			type = TCL_PATH_RELATIVE;
+		    } else {
+			char *colonPos = strchr(path,':');
+			if (colonPos == NULL) {
+			    type = TCL_PATH_RELATIVE;
+			} else {
+			}
+		    }
+		    if (type == TCL_PATH_ABSOLUTE) {
+			if (driveNameLengthPtr != NULL) {
+			    *driveNameLengthPtr = strlen(path);
+			}
+		    }
+#endif
 		}
-	    } else {
-		type = TCL_PATH_RELATIVE;
-	    }
-	    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 = TclDStringToObj(&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;
@@ -462,17 +520,18 @@ TclpGetNativePathType(
  *
  * 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.
- *
- *	Note this function currently calls the older Split(Plat)Path
- *	functions, which require more memory allocation than is desirable.
+ *      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.
+ *      
  * 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.
@@ -480,25 +539,29 @@ TclpGetNativePathType(
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj *
-TclpNativeSplitPath(
-    Tcl_Obj *pathPtr,		/* Path to split. */
-    int *lenPtr)		/* int to store number of path elements. */
+Tcl_Obj* 
+TclpNativeSplitPath(pathPtr, lenPtr)
+    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;
+	    
+	case TCL_PLATFORM_MAC:
+	    resultPtr = SplitMacPath(Tcl_GetString(pathPtr));
+	    break;
     }
 
     /*
@@ -516,19 +579,20 @@ TclpNativeSplitPath(
  *
  * 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.
@@ -537,18 +601,17 @@ TclpNativeSplitPath(
  */
 
 void
-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
+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
 				 * 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;
-    const char *str;
+    char *p, *str;
 
     /*
      * Perform the splitting, using objectified, vfs-aware code.
@@ -557,40 +620,38 @@ Tcl_SplitPath(
     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 = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);
+    *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(p, str, (size_t) len+1);
+	memcpy((VOID *) p, (VOID *) str, (size_t) len+1);
 	p += len+1;
     }
-
+    
     /*
      * Now set up the argv pointers.
      */
@@ -599,7 +660,7 @@ Tcl_SplitPath(
 
     for (i = 0; i < *argcPtr; i++) {
 	(*argvPtr)[i] = p;
-	for (; *(p++)!='\0'; );
+	while ((*p++) != '\0') {}
     }
     (*argvPtr)[i] = NULL;
 
@@ -615,8 +676,8 @@ Tcl_SplitPath(
  *
  * 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.
@@ -627,12 +688,12 @@ Tcl_SplitPath(
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj *
-SplitUnixPath(
-    const char *path)		/* Pointer to string containing a path. */
+static Tcl_Obj*
+SplitUnixPath(path)
+    CONST char *path;		/* Pointer to string containing a path. */
 {
     int length;
-    const char *p, *elementStart;
+    CONST char *p, *elementStart;
     Tcl_Obj *result = Tcl_NewObj();
 
     /*
@@ -643,12 +704,11 @@ SplitUnixPath(
     /*
      * 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++;
+	    ++path;
 	}
     }
 #endif
@@ -661,7 +721,7 @@ SplitUnixPath(
     }
 
     /*
-     * 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.
      */
 
@@ -674,7 +734,7 @@ SplitUnixPath(
 	if (length > 0) {
 	    Tcl_Obj *nextElt;
 	    if ((elementStart[0] == '~') && (elementStart != path)) {
-		TclNewLiteralStringObj(nextElt, "./");
+		nextElt = Tcl_NewStringObj("./",2);
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
 		nextElt = Tcl_NewStringObj(elementStart, length);
@@ -687,14 +747,15 @@ SplitUnixPath(
     }
     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.
@@ -705,17 +766,17 @@ SplitUnixPath(
  *----------------------------------------------------------------------
  */
 
-static Tcl_Obj *
-SplitWinPath(
-    const char *path)		/* Pointer to string containing a path. */
+static Tcl_Obj*
+SplitWinPath(path)
+    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);
 
     /*
@@ -723,14 +784,16 @@ SplitWinPath(
      */
 
     if (p != path) {
-	Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&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 {
@@ -741,10 +804,11 @@ SplitWinPath(
 	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] == ':'))) {
-		TclNewLiteralStringObj(nextElt, "./");
+		nextElt = Tcl_NewStringObj("./",2);
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
 		nextElt = Tcl_NewStringObj(elementStart, length);
@@ -757,56 +821,284 @@ SplitWinPath(
 }
 
 /*
- *---------------------------------------------------------------------------
- *
- * 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.
+ * SplitMacPath --
  *
- *	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).
+ *	This routine is used by Tcl_(FS)SplitPath to handle splitting
+ *	Macintosh paths.
  *
  * Results:
- *	Returns object owned by the caller (which should increment its
- *	refCount) - typically an object with refCount of zero.
+ *	Returns a newly allocated Tcl list object.
  *
  * Side effects:
  *	None.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
-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. */
+static Tcl_Obj*
+SplitMacPath(path)
+    CONST char *path;		/* Pointer to string containing a path. */
 {
-    if (pathPtr == NULL) {
-	return TclJoinPath(objc, objv);
+    int isMac = 0;		/* 1 if is Mac-style, 0 if Unix-style path. */
+    int length;
+    CONST char *p, *elementStart;
+    Tcl_Obj *result;
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+    Tcl_RegExp re;
+    int i;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+#endif
+    
+    result = Tcl_NewObj();
+    
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+    /*
+     * Initialize the path name parser for Macintosh path names.
+     */
+
+    FileNameInit();
+
+    /*
+     * Match the root portion of a Mac path name.
+     */
+
+    i = 0;			/* Needed only to prevent gcc warnings. */
+
+    re = Tcl_GetRegExpFromObj(NULL, tsdPtr->macRootPatternPtr, REG_ADVANCED);
+
+    if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
+	CONST char *start, *end;
+	Tcl_Obj *nextElt;
+
+	/*
+	 * Treat degenerate absolute paths like / and /../.. as
+	 * Mac relative file names for lack of anything else to do.
+	 */
+
+	Tcl_RegExpRange(re, 2, &start, &end);
+	if (start) {
+	    Tcl_Obj *elt = Tcl_NewStringObj(":", 1);
+	    Tcl_RegExpRange(re, 0, &start, &end);
+	    Tcl_AppendToObj(elt, path, end - start);
+	    Tcl_ListObjAppendElement(NULL, result, elt);
+	    return result;
+	}
+
+	Tcl_RegExpRange(re, 5, &start, &end);
+	if (start) {
+	    /*
+	     * Unix-style tilde prefixed paths.
+	     */
+
+	    isMac = 0;
+	    i = 5;
+	} else {
+	    Tcl_RegExpRange(re, 7, &start, &end);
+	    if (start) {
+		/*
+		 * Mac-style tilde prefixed paths.
+		 */
+
+		isMac = 1;
+		i = 7;
+	    } else {
+		Tcl_RegExpRange(re, 10, &start, &end);
+		if (start) {
+		    /*
+		     * Normal Unix style paths.
+		     */
+
+		    isMac = 0;
+		    i = 10;
+		} else {
+		    Tcl_RegExpRange(re, 12, &start, &end);
+		    if (start) {
+			/*
+			 * Normal Mac style paths.
+			 */
+
+			isMac = 1;
+			i = 12;
+		    }
+		}
+	    }
+	}
+	Tcl_RegExpRange(re, i, &start, &end);
+	length = end - start;
+
+	/*
+	 * Append the element and terminate it with a : 
+	 */
+
+	nextElt = Tcl_NewStringObj(start, length);
+	Tcl_AppendToObj(nextElt, ":", 1);
+	Tcl_ListObjAppendElement(NULL, result, nextElt);
+	p = end;
+    } else {
+	isMac = (strchr(path, ':') != NULL);
+	p = path;
     }
-    if (objc == 0) {
-	return TclJoinPath(1, &pathPtr);
+#else
+    if ((path[0] != ':') && (path[0] == '~' || (strchr(path,':') != NULL))) {
+	CONST char *end;
+	Tcl_Obj *nextElt;
+
+	isMac = 1;
+	
+	end = strchr(path,':');
+	if (end == NULL) {
+	    length = strlen(path);
+	} else {
+	    length = end - path;
+	}
+
+	/*
+	 * Append the element and terminate it with a :
+	 */
+
+	nextElt = Tcl_NewStringObj(path, length);
+	Tcl_AppendToObj(nextElt, ":", 1);
+	Tcl_ListObjAppendElement(NULL, result, nextElt);
+	p = path + length;
+    } else {
+	isMac = (strchr(path, ':') != NULL);
+	isMac = 1;
+	p = path;
     }
-    if (objc == 1) {
-	Tcl_Obj *pair[2];
+#endif
+    
+    if (isMac) {
+
+	/*
+	 * p is pointing at the first colon in the path.  There
+	 * will always be one, since this is a Mac-style path.
+	 * (This is no longer true if MAC_UNDERSTANDS_UNIX_PATHS 
+	 * is false, so we must check whether 'p' points to the
+	 * end of the string.)
+	 */
+	elementStart = p;
+	if (*p == ':') {
+	    p++;
+	}
+	
+	while ((p = strchr(p, ':')) != NULL) {
+	    length = p - elementStart;
+	    if (length == 1) {
+		while (*p == ':') {
+		    Tcl_ListObjAppendElement(NULL, result,
+			    Tcl_NewStringObj("::", 2));
+		    elementStart = p++;
+		}
+	    } else {
+		/*
+		 * If this is a simple component, drop the leading colon.
+		 */
 
-	pair[0] = pathPtr;
-	pair[1] = objv[0];
-	return TclJoinPath(2, pair);
+		if ((elementStart[1] != '~')
+			&& (strchr(elementStart+1, '/') == NULL)) {
+		    elementStart++;
+		    length--;
+		}
+		Tcl_ListObjAppendElement(NULL, result, 
+			Tcl_NewStringObj(elementStart, length));
+		elementStart = p++;
+	    }
+	}
+	if (elementStart[0] != ':') {
+	    if (elementStart[0] != '\0') {
+		Tcl_ListObjAppendElement(NULL, result, 
+			Tcl_NewStringObj(elementStart, -1));
+	    }
+	} else {
+	    if (elementStart[1] != '\0' || elementStart == path) {
+		if ((elementStart[1] != '~') && (elementStart[1] != '\0')
+			&& (strchr(elementStart+1, '/') == NULL)) {
+		    elementStart++;
+		}
+		Tcl_ListObjAppendElement(NULL, result, 
+			Tcl_NewStringObj(elementStart, -1));
+	    }
+	}
     } else {
-	int elemc = objc + 1;
-	Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj **));
 
-	elemv[0] = pathPtr;
-	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj **));
-	ret = TclJoinPath(elemc, elemv);
-	ckfree(elemv);
-	return ret;
+	/*
+	 * Split on slashes, suppress extra /'s, and convert .. to ::. 
+	 */
+
+	for (;;) {
+	    elementStart = p;
+	    while ((*p != '\0') && (*p != '/')) {
+		p++;
+	    }
+	    length = p - elementStart;
+	    if (length > 0) {
+		if ((length == 1) && (elementStart[0] == '.')) {
+		    Tcl_ListObjAppendElement(NULL, result, 
+					     Tcl_NewStringObj(":", 1));
+		} else if ((length == 2) && (elementStart[0] == '.')
+			&& (elementStart[1] == '.')) {
+		    Tcl_ListObjAppendElement(NULL, result, 
+					     Tcl_NewStringObj("::", 2));
+		} else {
+		    Tcl_Obj *nextElt;
+		    if (*elementStart == '~') {
+			nextElt = Tcl_NewStringObj(":",1);
+			Tcl_AppendToObj(nextElt, elementStart, length);
+		    } else {
+			nextElt = Tcl_NewStringObj(elementStart, length);
+		    }
+		    Tcl_ListObjAppendElement(NULL, result, nextElt);
+		}
+	    }
+	    if (*p++ == '\0') {
+		break;
+	    }
+	}
     }
+    return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *      Returns object with refCount of zero
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj* 
+Tcl_FSJoinToPath(basePtr, objc, objv)
+    Tcl_Obj *basePtr;
+    int objc;
+    Tcl_Obj *CONST objv[];
+{
+    int i;
+    Tcl_Obj *lobj, *ret;
+
+    if (basePtr == NULL) {
+	lobj = Tcl_NewListObj(0, NULL);
+    } else {
+	lobj = Tcl_NewListObj(1, &basePtr);
+    }
+    
+    for (i = 0; i<objc;i++) {
+	Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
+    }
+    ret = Tcl_FSJoinPath(lobj, -1);
+    Tcl_DecrRefCount(lobj);
+    return ret;
 }
 
 /*
@@ -814,10 +1106,10 @@ Tcl_FSJoinToPath(
  *
  * 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.
@@ -826,28 +1118,28 @@ Tcl_FSJoinToPath(
  */
 
 void
-TclpNativeJoinPath(
-    Tcl_Obj *prefix,
-    const char *joining)
+TclpNativeJoinPath(prefix, joining)
+    Tcl_Obj *prefix;
+    char* joining;
 {
     int length, needsSep;
-    char *dest;
-    const char *p;
-    const char *start;
-
+    char *dest, *p, *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;
 	}
     }
@@ -856,75 +1148,159 @@ TclpNativeJoinPath(
     }
 
     switch (tclPlatform) {
-    case TCL_PLATFORM_UNIX:
-	/*
-	 * Append a separator if needed.
-	 */
-
-	if (length > 0 && (start[length-1] != '/')) {
-	    Tcl_AppendToObj(prefix, "/", 1);
-	    length++;
-	}
-	needsSep = 0;
-
-	/*
-	 * Append the element, eliminating duplicate and trailing slashes.
-	 */
+        case TCL_PLATFORM_UNIX:
+	    /*
+	     * Append a separator if needed.
+	     */
 
-	Tcl_SetObjLength(prefix, length + (int) strlen(p));
+	    if (length > 0 && (start[length-1] != '/')) {
+		Tcl_AppendToObj(prefix, "/", 1);
+		length++;
+	    }
+	    needsSep = 0;
+	    
+	    /*
+	     * Append the element, eliminating duplicate and trailing
+	     * slashes.
+	     */
 
-	dest = Tcl_GetString(prefix) + length;
-	for (; *p != '\0'; p++) {
-	    if (*p == '/') {
-		while (p[1] == '/') {
-		    p++;
-		}
-		if (p[1] != '\0' && needsSep) {
-		    *dest++ = '/';
+	    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;
 		}
-	    } 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);
-	    length++;
-	}
-	needsSep = 0;
+		Tcl_AppendToObj(prefix, "/", 1);
+		length++;
+	    }
+	    needsSep = 0;
+	    
+	    /*
+	     * Append the element, eliminating duplicate and
+	     * trailing slashes.
+	     */
 
-	/*
-	 * 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;
 
-	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++;
+	case TCL_PLATFORM_MAC: {
+	    int newLength;
+	    
+	    /*
+	     * Sort out separators.  We basically add the object we've
+	     * been given, but we have to make sure that there is
+	     * exactly one separator inbetween (unless the object we're
+	     * adding contains multiple contiguous colons, all of which
+	     * we must add).  Also if an object is just ':' we don't
+	     * bother to add it unless it's the very first element.
+	     */
+
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+	    int adjustedPath = 0;
+	    if ((strchr(p, ':') == NULL) && (strchr(p, '/') != NULL)) {
+		char *start = p;
+		adjustedPath = 1;
+		while (*start != '\0') {
+		    if (*start == '/') {
+		        *start = ':';
+		    }
+		    start++;
+		}
+	    }
+#endif
+	    if (length > 0) {
+		if ((p[0] == ':') && (p[1] == '\0')) {
+		    return;
 		}
-		if ((p[1] != '\0') && needsSep) {
-		    *dest++ = '/';
+		if (start[length-1] != ':') {
+		    if (*p != '\0' && *p != ':') {
+			Tcl_AppendToObj(prefix, ":", 1);
+			length++;
+		    }
+		} else if (*p == ':') {
+		    p++;
 		}
 	    } else {
-		*dest++ = *p;
-		needsSep = 1;
+		if (*p != '\0' && *p != ':') {
+		    Tcl_AppendToObj(prefix, ":", 1);
+		    length++;
+		}
 	    }
+	    
+	    /*
+	     * Append the element
+	     */
+
+	    newLength = strlen(p);
+	    /* 
+	     * It may not be good to just do 'Tcl_AppendToObj(prefix,
+	     * p, newLength)' because the object may contain duplicate
+	     * colons which we want to get rid of.
+	     */
+	    Tcl_AppendToObj(prefix, p, newLength);
+	    
+	    /* Remove spurious trailing single ':' */
+	    dest = Tcl_GetString(prefix) + length + newLength;
+	    if (*(dest-1) == ':') {
+		if (dest-1 > Tcl_GetString(prefix)) {
+		    if (*(dest-2) != ':') {
+		        Tcl_SetObjLength(prefix, length + newLength -1);
+		    }
+		}
+	    }
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+	    /* Revert the path to what it was */
+	    if (adjustedPath) {
+		char *start = joining;
+		while (*start != '\0') {
+		    if (*start == ':') {
+			*start = '/';
+		    }
+		    start++;
+		}
+	    }
+#endif
+	    break;
 	}
-	length = dest - Tcl_GetString(prefix);
-	Tcl_SetObjLength(prefix, length);
-	break;
     }
     return;
 }
@@ -934,13 +1310,14 @@ TclpNativeJoinPath(
  *
  * 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.
@@ -949,46 +1326,34 @@ TclpNativeJoinPath(
  */
 
 char *
-Tcl_JoinPath(
-    int argc,
-    const char *const *argv,
-    Tcl_DString *resultPtr)	/* Pointer to previously initialized DString */
+Tcl_JoinPath(argc, argv, resultPtr)
+    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;
-    const char *resultStr;
-
-    /*
-     * Build the list of paths.
-     */
+    char *resultStr;
 
+    /* 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);
 }
 
@@ -998,19 +1363,19 @@ Tcl_JoinPath(
  * 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.
@@ -1019,15 +1384,15 @@ Tcl_JoinPath(
  */
 
 char *
-Tcl_TranslateFileName(
-    Tcl_Interp *interp,		/* Interpreter in which to store error message
-				 * (if necessary). */
-    const char *name,		/* File name, which may begin with "~" (to
+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
 				 * 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;
@@ -1038,15 +1403,15 @@ Tcl_TranslateFileName(
 	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) {
@@ -1057,7 +1422,6 @@ Tcl_TranslateFileName(
 	    }
 	}
     }
-
     return Tcl_DStringValue(bufferPtr);
 }
 
@@ -1066,12 +1430,12 @@ Tcl_TranslateFileName(
  *
  * 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.
@@ -1079,11 +1443,11 @@ Tcl_TranslateFileName(
  *----------------------------------------------------------------------
  */
 
-const char *
-TclGetExtension(
-    const char *name)		/* File name to parse. */
+char *
+TclGetExtension(name)
+    char *name;			/* File name to parse. */
 {
-    const char *p, *lastSep;
+    char *p, *lastSep;
 
     /*
      * First find the last directory separator.
@@ -1091,18 +1455,30 @@ TclGetExtension(
 
     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_MAC:
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+	    if (strchr(name, ':') == NULL) {
+		lastSep = strrchr(name, '/');
+	    } else {
+		lastSep = strrchr(name, ':');
 	    }
-	}
-	break;
+#else
+	    lastSep = strrchr(name, ':');
+#endif
+	    break;
+
+	case TCL_PLATFORM_WINDOWS:
+	    lastSep = NULL;
+	    for (p = name; *p != '\0'; p++) {
+		if (strchr("/\\:", *p) != NULL) {
+		    lastSep = p;
+		}
+	    }
+	    break;
     }
     p = strrchr(name, '.');
     if ((p != NULL) && (lastSep != NULL) && (lastSep > p)) {
@@ -1111,7 +1487,7 @@ TclGetExtension(
 
     /*
      * 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.
      */
@@ -1129,10 +1505,11 @@ TclGetExtension(
  *
  * 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.
@@ -1140,38 +1517,40 @@ TclGetExtension(
  *----------------------------------------------------------------------
  */
 
-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
+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
 				 * 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", NULL);
+		Tcl_AppendResult(interp, "couldn't find HOME environment ",
+			"variable to expand path", (char *) 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",
-		    NULL);
+    } else {
+	if (TclpGetUserHome(user, resultPtr) == NULL) {	
+	    if (interp) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
+			(char *) NULL);
+	    }
+	    return NULL;
 	}
-	return NULL;
     }
     return Tcl_DStringValue(resultPtr);
 }
@@ -1181,8 +1560,8 @@ DoTildeSubst(
  *
  * 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.
@@ -1195,24 +1574,23 @@ DoTildeSubst(
 
 	/* ARGSUSED */
 int
-Tcl_GlobObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int index, i, globFlags, length, join, dir, result;
-    char *string;
-    const char *separators;
-    Tcl_Obj *typePtr, *look;
+    char *string, *separators;
+    Tcl_Obj *typePtr, *resultPtr, *look;
     Tcl_Obj *pathOrDir = NULL;
     Tcl_DString prefix;
-    static const char *const 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};
@@ -1223,185 +1601,159 @@ Tcl_GlobObjCmd(
     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));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		return TCL_ERROR;
-	    }
-	    if (dir != PATH_NONE) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"\"-directory\" cannot be used with \"-path\"", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
-			"BADOPTIONCOMBINATION", NULL);
-		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));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		return TCL_ERROR;
-	    }
-	    if (dir != PATH_NONE) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"\"-path\" cannot be used with \"-directory\"", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
-			"BADOPTIONCOMBINATION", NULL);
-		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));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
-		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 ...?");
+	return TCL_ERROR;
+    }
     if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
-	Tcl_AppendResult(interp,
-		"\"-tails\" must be used with either "
-		"\"-directory\" or \"-path\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
-		"BADOPTIONCOMBINATION", NULL);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	  "\"-tails\" must be used with either \"-directory\" or \"-path\"",
+	  -1));
 	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;
+	case TCL_PLATFORM_MAC:
+	    separators = ":";
+	    break;
     }
-
     if (dir == PATH_GENERAL) {
 	int pathlength;
-	const char *last;
-	const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
+	char *last;
+	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. 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.
-		 */
-
+		/* The whole thing is a prefix */
 		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);
@@ -1409,32 +1761,29 @@ Tcl_GlobObjCmd(
 	    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 = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
+	globTypes = (Tcl_GlobTypeData*) ckalloc(sizeof(Tcl_GlobTypeData));
 	globTypes->type = 0;
 	globTypes->perm = 0;
 	globTypes->macType = NULL;
 	globTypes->macCreator = NULL;
-
-	while (--length >= 0) {
+	while(--length >= 0) {
 	    int len;
-	    const char *str;
-
+	    char *str;
 	    Tcl_ListObjIndex(interp, typePtr, length, &look);
 	    str = Tcl_GetStringFromObj(look, &len);
 	    if (strcmp("readonly", str) == 0) {
@@ -1443,56 +1792,50 @@ Tcl_GlobObjCmd(
 		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);
@@ -1515,27 +1858,23 @@ Tcl_GlobObjCmd(
 			}
 		    }
 		}
-
 		/*
-		 * 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:
-		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"bad argument to \"-types\": %s",
-			Tcl_GetString(look)));
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
+		badTypesArg:
+		resultPtr = Tcl_GetObjResult(interp);
+		Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
+		Tcl_AppendObjToObj(resultPtr, look);
 		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;
-		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
 		join = 0;
 		goto endOfGlob;
 	    }
@@ -1543,16 +1882,15 @@ Tcl_GlobObjCmd(
     }
 
   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);
@@ -1564,73 +1902,66 @@ Tcl_GlobObjCmd(
 		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;
-	    }
-	}
-	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 (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;
+		}
+	    }
+	    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 \"", NULL);
+		    (join || (objc == 1)) ? " \"" : "s \"", (char *) NULL);
 	    if (join) {
-		Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
+		Tcl_AppendResult(interp, Tcl_DStringValue(&prefix),
+			(char *) NULL);
 	    } else {
-		const char *sep = "";
-
+		char *sep = "";
 		for (i = 0; i < objc; i++) {
 		    string = Tcl_GetString(objv[i]);
-		    Tcl_AppendResult(interp, sep, string, NULL);
+		    Tcl_AppendResult(interp, sep, string, (char *) NULL);
 		    sep = " ";
 		}
 	    }
-	    Tcl_AppendResult(interp, "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
-		    NULL);
+	    Tcl_AppendResult(interp, "\"", (char *) NULL);
 	    result = TCL_ERROR;
 	}
     }
-
   endOfGlob:
     if (join || (dir == PATH_GENERAL)) {
 	Tcl_DStringFree(&prefix);
@@ -1645,7 +1976,7 @@ Tcl_GlobObjCmd(
 	if (globTypes->macCreator != NULL) {
 	    Tcl_DecrRefCount(globTypes->macCreator);
 	}
-	TclStackFree(interp, globTypes);
+	ckfree((char *) globTypes);
     }
     return result;
 }
@@ -1655,24 +1986,24 @@ Tcl_GlobObjCmd(
  *
  * TclGlob --
  *
- *	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).
+ *	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.
  *
  * 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 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.
+ *	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.
  *
  * Side effects:
  *	The 'pattern' is written to.
@@ -1682,347 +2013,216 @@ Tcl_GlobObjCmd(
 
 	/* ARGSUSED */
 int
-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. */
+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. */
 {
-    const char *separators;
-    const char *head;
+    char *separators;
+    CONST char *head;
     char *tail, *start;
-    int result;
-    Tcl_Obj *filenamesObj, *savedResultObj;
+    char c;
+    int result, prefixLen;
+    Tcl_DString buffer;
+    Tcl_Obj *oldResult;
 
     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;
+	case TCL_PLATFORM_MAC:
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+	    if (unquotedPrefix == NULL) {
+		separators = (strchr(pattern, ':') == NULL) ? "/" : ":";
+	    } else {
+		separators = ":";
+	    }
+#else
+	    separators = ":";
+#endif
+	    break;
     }
 
-    if (pathPrefix == NULL) {
-	char c;
-	Tcl_DString buffer;
-	Tcl_DStringInit(&buffer);
-
+    Tcl_DStringInit(&buffer);
+    if (unquotedPrefix != NULL) {
+	start = Tcl_GetString(unquotedPrefix);
+    } else {
 	start = pattern;
+    }
+
+    /*
+     * Perform tilde substitution, if needed.
+     */
 
+    if (start[0] == '~') {
+	
 	/*
-	 * Perform tilde substitution, if needed.
+	 * Find the first path separator after the tilde.
 	 */
-
-	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) {
+	for (tail = start; *tail != '\0'; tail++) {
+	    if (*tail == '\\') {
+		if (strchr(separators, tail[1]) != NULL) {
 		    break;
 		}
+	    } else if (strchr(separators, *tail) != NULL) {
+		break;
 	    }
+	}
 
-	    /*
-	     * Determine the home directory for the specified user.
+	/*
+	 * 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.
 	     */
-
-	    c = *tail;
-	    *tail = '\0';
+	    head = DoTildeSubst(NULL, start+1, &buffer);
+	} else {
 	    head = DoTildeSubst(interp, start+1, &buffer);
-	    *tail = c;
-	    if (head == NULL) {
+	}
+	*tail = c;
+	if (head == NULL) {
+	    if (globFlags & TCL_GLOBMODE_NO_COMPLAIN) {
+		return TCL_OK;
+	    } else {
 		return TCL_ERROR;
 	    }
-	    if (head != Tcl_DStringValue(&buffer)) {
-		Tcl_DStringAppend(&buffer, head, -1);
-	    }
-	    pathPrefix = TclDStringToObj(&buffer);
-	    Tcl_IncrRefCount(pathPrefix);
-	    globFlags |= TCL_GLOBMODE_DIR;
-	    if (c != '\0') {
-		tail++;
-	    }
-	} else {
+	}
+	if (head != Tcl_DStringValue(&buffer)) {
+	    Tcl_DStringAppend(&buffer, head, -1);
+	}
+	if (unquotedPrefix != NULL) {
+	    Tcl_DStringAppend(&buffer, tail, -1);
 	    tail = pattern;
 	}
     } else {
-	Tcl_IncrRefCount(pathPrefix);
 	tail = pattern;
+	if (unquotedPrefix != NULL) {
+	    Tcl_DStringAppend(&buffer,Tcl_GetString(unquotedPrefix),-1);
+	}
     }
-
-    /*
-     * 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.
+    
+    /* 
+     * 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.
      */
-
-    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] == '/') {
+    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) {
 		    tail++;
-		} else {
-		    tail += 2;
 		}
-		Tcl_IncrRefCount(pathPrefix);
-		break;
 	    }
-	    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);
-	}
-    }
-
-    /*
-     * 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;
+	    prefixLen++;
 	}
     }
 
-    /*
-     * 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.
+    /* 
+     * We need to get the old result, in case it is over-written
+     * below when we still need it.
      */
-
-    savedResultObj = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(savedResultObj);
+    oldResult = Tcl_GetObjResult(interp);
+    Tcl_IncrRefCount(oldResult);
     Tcl_ResetResult(interp);
-    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 = 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);
 	    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 {
-	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) {
+	/* 
+	 * 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.
+	 */
 	int objc, i;
 	Tcl_Obj **objv;
-	int prefixLen;
-	const char *pre;
 
-	/*
-	 * If this length has never been set, set it here.
-	 */
-
-	if (pathPrefix == NULL) {
-	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
-	}
-
-	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++;
+	/* Ensure sole ownership */
+	if (Tcl_IsShared(oldResult)) {
+	    Tcl_DecrRefCount(oldResult);
+	    oldResult = Tcl_DuplicateObj(oldResult);
+	    Tcl_IncrRefCount(oldResult);
+	}
+
+	Tcl_ListObjGetElements(NULL, Tcl_GetObjResult(interp), 
+			       &objc, &objv);
+#ifdef MAC_TCL
+	/* adjust prefixLen if TclDoGlob prepended a ':' */
+	if ((prefixLen > 0) && (objc > 0)
+	&& (Tcl_DStringValue(&buffer)[0] != ':')) {
+	    char *str = Tcl_GetStringFromObj(objv[0],NULL);
+	    if (str[0] == ':') {
+		    prefixLen++;
 	    }
 	}
-
-	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
+#endif
 	for (i = 0; i< objc; i++) {
-	    int len;
-	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
-	    Tcl_Obj *elem;
-
-	    if (len == prefixLen) {
-		if ((pattern[0] == '\0')
+	    Tcl_Obj* elt;
+	    if (globFlags & TCL_GLOBMODE_TAILS) {
+		int len;
+		char *oldStr = Tcl_GetStringFromObj(objv[i],&len);
+		if (len == prefixLen) {
+		    if ((pattern[0] == '\0')
 			|| (strchr(separators, pattern[0]) == NULL)) {
-		    TclNewLiteralStringObj(elem, ".");
+			elt = Tcl_NewStringObj(".",1);
+		    } else {
+			elt = Tcl_NewStringObj("/",1);
+		    }
 		} else {
-		    TclNewLiteralStringObj(elem, "/");
+		    elt = Tcl_NewStringObj(oldStr + prefixLen, 
+						len - prefixLen);
 		}
 	    } else {
-		elem = Tcl_NewStringObj(oldStr+prefixLen, len-prefixLen);
+		elt = objv[i];
 	    }
-	    Tcl_ListObjReplace(interp, filenamesObj, i, 1, 1, &elem);
+	    /* Assumption that 'oldResult' is a valid list */
+	    Tcl_ListObjAppendElement(interp, oldResult, elt);
 	}
+	Tcl_SetObjResult(interp, oldResult);
     }
-
-    /*
-     * 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.
+    /* 
+     * Release our temporary copy.  All code paths above must
+     * end here so we free our reference.
      */
-
-    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);
-    }
-
+    Tcl_DecrRefCount(oldResult);
+    Tcl_DStringFree(&buffer);
     return result;
 }
 
@@ -2031,13 +2231,14 @@ TclGlob(
  *
  * 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.
@@ -2046,9 +2247,9 @@ TclGlob(
  */
 
 static int
-SkipToChar(
-    char **stringPtr,		/* Pointer string to check. */
-    int match)			/* Character to find. */
+SkipToChar(stringPtr, match)
+    char **stringPtr;			/* Pointer string to check. */
+    char *match;			/* Pointer to character to find. */
 {
     int quoted, level;
     register char *p;
@@ -2061,7 +2262,7 @@ SkipToChar(
 	    quoted = 0;
 	    continue;
 	}
-	if ((level == 0) && (*p == match)) {
+	if ((level == 0) && (*p == *match)) {
 	    *stringPtr = p;
 	    return 1;
 	}
@@ -2080,23 +2281,23 @@ SkipToChar(
 /*
  *----------------------------------------------------------------------
  *
- * DoGlob --
+ * TclDoGlob --
  *
- *	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).
+ *	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).
  *
  * 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 remaining
- *	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 rem arguments.  After an error the
+ *	result in interp will hold an error message.
  *
  * Side effects:
  *	None.
@@ -2104,105 +2305,166 @@ SkipToChar(
  *----------------------------------------------------------------------
  */
 
-static int
-DoGlob(
-    Tcl_Interp *interp,		/* Interpreter to use for error reporting
+int
+TclDoGlob(interp, separators, headPtr, tail, types)
+    Tcl_Interp *interp;		/* Interpreter to use for error reporting
 				 * (e.g. unmatched brace). */
-    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
+    char *separators;		/* String containing separator characters
+				 * that should be used to identify globbing
 				 * boundaries. */
-    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. */
+    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. */
 {
     int baseLength, quoted, count;
     int result = TCL_OK;
-    char *name, *p, *openBrace, *closeBrace, *firstSpecialChar;
-    Tcl_Obj *joinedPtr;
+    char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar;
+    char lastChar = 0;
+    
+    int length = Tcl_DStringLength(headPtr);
+
+    if (length > 0) {
+	lastChar = Tcl_DStringValue(headPtr)[length-1];
+    }
 
     /*
-     * Consume any leading directory separators, leaving pattern pointing just
-     * past the last initial separator.
+     * Consume any leading directory separators, leaving tail pointing
+     * just past the last initial separator.
      */
 
     count = 0;
-    name = pattern;
-    for (; *pattern != '\0'; pattern++) {
-	if (*pattern == '\\') {
-	    /*
+    name = tail;
+    for (; *tail != '\0'; tail++) {
+	if (*tail == '\\') {
+	    /* 
 	     * If the first character is escaped, either we have a directory
-	     * 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.
+	     * 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.
 	     */
-
-	    if (strchr(separators, pattern[1]) != NULL) {
-		pattern++;
+	    if (strchr(separators, tail[1]) != NULL) {
+		tail++;
 	    } else {
 		break;
 	    }
-	} else if (strchr(separators, *pattern) == NULL) {
+	} else if (strchr(separators, *tail) == NULL) {
 	    break;
 	}
+	if (tclPlatform != TCL_PLATFORM_MAC) {
+	    if (*tail == '\\') {
+		Tcl_DStringAppend(headPtr, separators, 1);
+	    } else {
+		Tcl_DStringAppend(headPtr, tail, 1);
+	    }
+	}
 	count++;
     }
 
     /*
-     * Look for the first matching pair of braces or the first directory
-     * separator that is not inside a pair of braces.
+     * 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_MAC:
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+	    if (*separators == '/') {
+		if (((length == 0) && (count == 0))
+			|| ((length > 0) && (lastChar != ':'))) {
+		    Tcl_DStringAppend(headPtr, ":", 1);
+		}
+	    } else {
+#endif
+		if (count == 0) {
+		    if ((length > 0) && (lastChar != ':')) {
+			Tcl_DStringAppend(headPtr, ":", 1);
+		    }
+		} else {
+		    if (lastChar == ':') {
+			count--;
+		    }
+		    while (count-- > 0) {
+			Tcl_DStringAppend(headPtr, ":", 1);
+		    }
+		}
+#ifdef MAC_UNDERSTANDS_UNIX_PATHS
+	    }
+#endif
+	    break;
+	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.
      */
 
     openBrace = closeBrace = NULL;
     quoted = 0;
-    for (p = pattern; *p != '\0'; p++) {
+    for (p = tail; *p != '\0'; p++) {
 	if (quoted) {
 	    quoted = 0;
-
 	} else if (*p == '\\') {
 	    quoted = 1;
 	    if (strchr(separators, p[1]) != NULL) {
-		/*
-		 * Quoted directory separator.
-		 */
-		break;
+		break;			/* Quoted directory separator. */
 	    }
-
 	} else if (strchr(separators, *p) != NULL) {
-	    /*
-	     * Unquoted directory separator.
-	     */
-	    break;
-
+	    break;			/* Unquoted directory separator. */
 	} else if (*p == '{') {
 	    openBrace = p;
 	    p++;
-	    if (SkipToChar(&p, '}')) {
-		/*
-		 * Balanced braces.
-		 */
-
-		closeBrace = p;
+	    if (SkipToChar(&p, "}")) {
+		closeBrace = p;		/* Balanced braces. */
 		break;
 	    }
 	    Tcl_SetResult(interp, "unmatched open-brace in file name",
 		    TCL_STATIC);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
-		    NULL);
 	    return TCL_ERROR;
-
 	} else if (*p == '}') {
 	    Tcl_SetResult(interp, "unmatched close-brace in file name",
 		    TCL_STATIC);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
-		    NULL);
 	    return TCL_ERROR;
 	}
     }
@@ -2214,27 +2476,28 @@ DoGlob(
     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 DoGlob.
+	 * 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.
 	 */
 
-	Tcl_DStringAppend(&newName, pattern, openBrace-pattern);
+	Tcl_DStringAppend(&newName, tail, openBrace-tail);
 	baseLength = Tcl_DStringLength(&newName);
+	length = Tcl_DStringLength(headPtr);
 	*closeBrace = '\0';
 	for (p = openBrace; p != closeBrace; ) {
 	    p++;
 	    element = p;
-	    SkipToChar(&p, ',');
+	    SkipToChar(&p, ",");
+	    Tcl_DStringSetLength(headPtr, length);
 	    Tcl_DStringSetLength(&newName, baseLength);
 	    Tcl_DStringAppend(&newName, element, p-element);
 	    Tcl_DStringAppend(&newName, closeBrace+1, -1);
-	    result = DoGlob(interp, matchesObj, separators, pathPtr, flags,
-		    Tcl_DStringValue(&newName), types);
+	    result = TclDoGlob(interp, separators, headPtr, 
+			       Tcl_DStringValue(&newName), types);
 	    if (result != TCL_OK) {
 		break;
 	    }
@@ -2245,399 +2508,265 @@ DoGlob(
     }
 
     /*
-     * 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.
+     * 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.
      */
 
     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(pattern, "*[]?\\");
+	firstSpecialChar = strpbrk(tail, "*[]?\\");
 	*p = savedChar;
     } else {
-	firstSpecialChar = strpbrk(pattern, "*[]?\\");
+	firstSpecialChar = strpbrk(tail, "*[]?\\");
     }
 
     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 filesystem 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 platform 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') {
-	    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++;
+	    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);
+			if(tclPlatform == TCL_PLATFORM_MAC) {
+			    Tcl_DStringAppend(&ds, ":",1);
+			} else {
+			    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;
+			}
 		    }
-		    repair = -1;
 		}
 	    }
+	    Tcl_DecrRefCount(resultPtr);
 	}
-	TclDecrRefCount(subdirsPtr);
-	return result;
+	Tcl_DecrRefCount(head);
+	return ret;
     }
-
-    /*
-     * We reach here with no pattern char in current section
-     */
-
-    if (*p == '\0') {
-	int length;
-	Tcl_DString append;
-
+    Tcl_DStringAppend(headPtr, tail, p-tail);
+    if (*p != '\0') {
+	return TclDoGlob(interp, separators, headPtr, p, types);
+    } else {
 	/*
 	 * 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 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).
+	 * 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).
 	 */
 
-	Tcl_DStringInit(&append);
-	Tcl_DStringAppend(&append, pattern, p-pattern);
-
-	if (pathPtr != NULL) {
-	    (void) Tcl_GetStringFromObj(pathPtr, &length);
-	} else {
-	    length = 0;
-	}
+	Tcl_Obj *nameObj;
 
 	switch (tclPlatform) {
-	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);
+	    case TCL_PLATFORM_MAC: {
+		if (strchr(Tcl_DStringValue(headPtr), ':') == NULL) {
+		    Tcl_DStringAppend(headPtr, ":", 1);
 		}
+		break;
 	    }
-
-	    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);
+	    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);
+		    }
 		}
-	    }
-#if defined(__CYGWIN__) && !defined(__WIN32__)
-	    {
-		DLLIMPORT extern int cygwin_conv_to_posix_path(const char *,
-			char *);
-		char winbuf[MAXPATHLEN+1];
-
-		cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
-		Tcl_DStringFree(&append);
-		Tcl_DStringAppend(&append, winbuf, -1);
-	    }
-#endif /* __CYGWIN__ && __WIN32__ */
-	    break;
-	}
-
-	/*
-	 * Common for all platforms.
-	 */
-
-	if (pathPtr == NULL) {
-	    joinedPtr = TclDStringToObj(&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.
+		/* 
+		 * 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.
 		 */
-
-		int len;
-		const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
-
-		if (strchr(separators, joined[len-1]) == NULL) {
-		    Tcl_AppendToObj(joinedPtr, "/", 1);
+		for (p = Tcl_DStringValue(headPtr); *p != '\0'; p++) {
+		    if (*p == '\\') {
+			*p = '/';
+		    }
 		}
+		break;
 	    }
-	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
-		    Tcl_DStringLength(&append));
-	}
-	Tcl_IncrRefCount(joinedPtr);
-	Tcl_DStringFree(&append);
-	result = Tcl_FSMatchInDirectory(interp, matchesObj, joinedPtr, NULL,
-		types);
-	Tcl_DecrRefCount(joinedPtr);
-	return result;
-    }
-
-    /*
-     * If it's not the end of the string, we must recurse
-     */
-
-    if (pathPtr == NULL) {
-	joinedPtr = Tcl_NewStringObj(pattern, p-pattern);
-    } else if (flags) {
-	joinedPtr = TclNewFSPathObj(pathPtr, pattern, p-pattern);
-    } else {
-	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);
+	    case TCL_PLATFORM_UNIX: {
+		if (Tcl_DStringLength(headPtr) == 0) {
+		    if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
+			Tcl_DStringAppend(headPtr, "/", 1);
+		    } else {
+			Tcl_DStringAppend(headPtr, ".", 1);
+		    }
 		}
+		break;
 	    }
 	}
-	Tcl_AppendToObj(joinedPtr, pattern, p-pattern);
-    }
-
-    Tcl_IncrRefCount(joinedPtr);
-    result = DoGlob(interp, matchesObj, separators, joinedPtr, 1, p, types);
-    Tcl_DecrRefCount(joinedPtr);
+	/* Common for all platforms */
+	name = Tcl_DStringValue(headPtr);
+	nameObj = Tcl_NewStringObj(name, Tcl_DStringLength(headPtr));
 
-    return result;
+	Tcl_IncrRefCount(nameObj);
+	result = Tcl_FSMatchInDirectory(interp, Tcl_GetObjResult(interp),
+		nameObj, NULL, types);
+	Tcl_DecrRefCount(nameObj);
+	return result;
+    }
 }
+
 
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_AllocStatBuf --
+ * TclFileDirname
  *
- *	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 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:
- *	A pointer to a Tcl_StatBuf which may be deallocated by being passed to
- *	ckfree().
+ *	NULL if an error occurred, otherwise a Tcl_Obj owned by
+ *	the caller (i.e. most likely with refCount 1).
  *
  * Side effects:
- *	None.
+ *      None.
  *
  *---------------------------------------------------------------------------
  */
 
-Tcl_StatBuf *
-Tcl_AllocStatBuf(void)
+Tcl_Obj*
+TclFileDirname(interp, pathPtr)
+    Tcl_Interp *interp;		/* Used for error reporting */
+    Tcl_Obj *pathPtr;           /* Path to take dirname of */
 {
-    return ckalloc(sizeof(Tcl_StatBuf));
+    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;
+	}
+	splitPtr = Tcl_FSSplitPath(splitPtr, &splitElements);
+    }
+
+    /*
+     * 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) {
+	splitResultPtr = Tcl_FSJoinPath(splitPtr, splitElements - 1);
+    } else if (splitElements == 0 || 
+      (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE)) {
+	splitResultPtr = Tcl_NewStringObj(
+		((tclPlatform == TCL_PLATFORM_MAC) ? ":" : "."), 1);
+    } else {
+	Tcl_ListObjIndex(NULL, splitPtr, 0, &splitResultPtr);
+    }
+    Tcl_IncrRefCount(splitResultPtr);
+    Tcl_DecrRefCount(splitPtr);
+    return splitResultPtr;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * Access functions for Tcl_StatBuf --
+ * Tcl_AllocStatBuf
  *
- *	These functions provide portable read-only access to the portable
- *	fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
- *	stat64' or something else related). [TIP #316]
+ *     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:
- *	The value from the field being retrieved.
+ *     A pointer to a Tcl_StatBuf which may be deallocated by being
+ *     passed to ckfree().
  *
  * Side effects:
- *	None.
+ *      None.
  *
  *---------------------------------------------------------------------------
  */
 
-unsigned
-Tcl_GetFSDeviceFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (unsigned) statPtr->st_dev;
-}
-
-unsigned
-Tcl_GetFSInodeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (unsigned) statPtr->st_ino;
-}
-
-unsigned
-Tcl_GetModeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (unsigned) statPtr->st_mode;
-}
-
-int
-Tcl_GetLinkCountFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (int)statPtr->st_nlink;
-}
-
-int
-Tcl_GetUserIdFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (int) statPtr->st_uid;
-}
-
-int
-Tcl_GetGroupIdFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (int) statPtr->st_gid;
-}
-
-int
-Tcl_GetDeviceTypeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (int) statPtr->st_rdev;
-}
-
-Tcl_WideInt
-Tcl_GetAccessTimeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (Tcl_WideInt) statPtr->st_atime;
-}
-
-Tcl_WideInt
-Tcl_GetModificationTimeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (Tcl_WideInt) statPtr->st_mtime;
-}
-
-Tcl_WideInt
-Tcl_GetChangeTimeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (Tcl_WideInt) statPtr->st_ctime;
-}
-
-Tcl_WideUInt
-Tcl_GetSizeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-    return (Tcl_WideUInt) statPtr->st_size;
-}
-
-Tcl_WideUInt
-Tcl_GetBlocksFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
-    return (Tcl_WideUInt) statPtr->st_blocks;
-#else
-    register unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
-
-    return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
-#endif
-}
-
-unsigned
-Tcl_GetBlockSizeFromStat(
-    const Tcl_StatBuf *statPtr)
-{
-#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
-    return (unsigned) statPtr->st_blksize;
-#else
-    /*
-     * Not a great guess, but will do...
-     */
-
-    return GUESSED_BLOCK_SIZE;
-#endif
+Tcl_StatBuf *
+Tcl_AllocStatBuf() {
+    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
deleted file mode 100644
index 5e48dec..0000000
--- a/generic/tclFileSystem.h
+++ /dev/null
@@ -1,121 +0,0 @@
-/*
- * 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"
-
-/*
- * 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.
- */
-
-typedef struct FilesystemRecord {
-    ClientData clientData;	/* Client specific data for the new filesystem
-				 * (can be NULL) */
-    const 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. */
-} FilesystemRecord;
-
-/*
- * 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.
- */
-
-typedef struct ThreadSpecificData {
-    int initialized;
-    int cwdPathEpoch;
-    int filesystemEpoch;
-    Tcl_Obj *cwdPathPtr;
-    ClientData cwdClientData;
-    FilesystemRecord *filesystemList;
-} ThreadSpecificData;
-
-/*
- * 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	TclFSMakePathFromNormalized(Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr, ClientData clientData);
-MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr, int startAt,
-			    ClientData *clientDataPtr);
-MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
-MODULE_SCOPE Tcl_Obj *	TclFSInternalToNormalized(
-			    const Tcl_Filesystem *fromFilesystem,
-			    ClientData clientData,
-			    FilesystemRecord **fsRecPtrPtr);
-MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
-			    const Tcl_Filesystem **fsPtrPtr);
-MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
-			    FilesystemRecord *fsRecPtr,
-			    ClientData clientData);
-MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
-			    Tcl_Obj *pathPtr, ClientData *clientDataPtr);
-
-/*
- * Private shared variables for use by tclIOUtil.c and tclPathObj.c
- */
-
-MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
-MODULE_SCOPE Tcl_ThreadDataKey tclFsDataKey;
-
-/*
- * 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,
-			    const Tcl_Filesystem **filesystemPtrPtr,
-			    int *driveNameLengthPtr);
-MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
-			    int pathLen, const Tcl_Filesystem **filesystemPtrPtr,
-			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
-MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
-			    const 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 4c19b55..b15f100 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -1,18 +1,21 @@
-/*
+/* 
  * tclGet.c --
  *
- *	This file contains functions to convert strings into other forms, like
- *	integers or floating-point numbers or booleans, doing syntax checking
- *	along the way.
+ *	This file contains procedures 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 "tclMath.h"
+
 
 /*
  *----------------------------------------------------------------------
@@ -22,10 +25,109 @@
  *	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 src.  If src 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 string.  If
+ *	string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in the interp's result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    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;
+    }
+
+    /*
+     * 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.
+     */
+
+    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;
+    }
+    *intPtr = (int) i;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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".
+ *
+ * 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. 
  *
  * Side effects:
  *	None.
@@ -34,27 +136,64 @@
  */
 
 int
-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. */
+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. */
 {
-    Tcl_Obj obj;
-    int code;
+    char *end;
+    CONST char *p = string;
+    long i;
 
-    obj.refCount = 1;
-    obj.bytes = (char *) src;
-    obj.length = strlen(src);
-    obj.typePtr = NULL;
+    /*
+     * Note: don't depend on strtoul to handle sign characters; it won't
+     * in some implementations.
+     */
 
-    code = Tcl_GetIntFromObj(interp, &obj, intPtr);
-    if (obj.refCount > 1) {
-	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
+    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;
     }
-    TclFreeIntRep(&obj);
-    return code;
+    while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
+	end++;
+    }
+    if (*end != 0) {
+	goto badInteger;
+    }
+    *longPtr = i;
+    return TCL_OK;
 }
 
 /*
@@ -66,10 +205,10 @@ Tcl_GetInt(
  *	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 src. If src 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 string.
+ *	If string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in the interp's result.
  *
  * Side effects:
  *	None.
@@ -78,27 +217,40 @@ Tcl_GetInt(
  */
 
 int
-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. */
+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_Obj obj;
-    int code;
-
-    obj.refCount = 1;
-    obj.bytes = (char *) src;
-    obj.length = strlen(src);
-    obj.typePtr = NULL;
+    char *end;
+    double d;
 
-    code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr);
-    if (obj.refCount > 1) {
-	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
+    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++;
     }
-    TclFreeIntRep(&obj);
-    return code;
+    if (*end != 0) {
+	goto badDouble;
+    }
+    *doublePtr = d;
+    return TCL_OK;
 }
 
 /*
@@ -106,14 +258,14 @@ Tcl_GetDouble(
  *
  * 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 src. If src 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 string.  If
+ *	string is improperly formed then TCL_ERROR is returned and
+ *	an error message will be left in the interp's result.
  *
  * Side effects:
  *	None.
@@ -122,35 +274,64 @@ Tcl_GetDouble(
  */
 
 int
-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. */
+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_Obj obj;
-    int code;
+    int i;
+    char lowerCase[10], c;
+    size_t length;
 
-    obj.refCount = 1;
-    obj.bytes = (char *) src;
-    obj.length = strlen(src);
-    obj.typePtr = NULL;
+    /*
+     * Convert the input string to all lower-case. 
+     * INTL: This code will work on UTF strings.
+     */
 
-    code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
-    if (obj.refCount > 1) {
-	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
+    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;
     }
-    if (code == TCL_OK) {
-	*boolPtr = obj.internalRep.longValue;
+    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;
     }
-    return code;
+    return TCL_OK;
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index da4c3fd..d210526 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -1,409 +1,337 @@
-/*
+/* 
  * 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. 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.
+ *	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.
  *
  * 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"
 
-/*
- * 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
+#include "tclInt.h"
+#include "tclPort.h"
+
+#if defined(MAC_TCL) && !defined(TCL_MAC_USE_MSL_EPOCH)
+#   define EPOCH           1904
+#   define START_OF_TIME   1904
+#   define END_OF_TIME     2039
+#else
+#   define EPOCH           1970
+#   define START_OF_TIME   1902
+#   define END_OF_TIME     2037
+#endif
 
 /*
  * The offset of tm_year of struct tm returned by localtime, gmtime, etc.
- * Posix requires 1900.
+ * 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.
  */
+#define TM_YEAR_BASE 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 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 {
-    const char *name;
-    int type;
-    time_t value;
+    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;
 
-%}
-
-%union {
-    time_t Number;
-    enum _MERIDIAN 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;
 
 /*
  * 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));
 
-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*);
-
+int
+yyparse _ANSI_ARGS_((void));
 %}
 
-%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
+%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
 
-spec	: /* NULL */
-	| spec item
-	;
+%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
 
-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);
-	    ++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 {
+        }
+        | 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 {
 	    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;
@@ -411,22 +339,21 @@ 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;
@@ -435,340 +362,521 @@ 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;
+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;
 	    } else {
-		yyHaveTime++;
-		if (yyDigitCount <= 2) {
-		    yyHour = $1;
-		    yyMinutes = 0;
-		} else {
-		    yyHour = $1 / 100;
-		    yyMinutes = $1 % 100;
-		}
-		yySeconds = 0;
-		yyMeridian = MER24;
+		yyHour = $1 / 100;
+		yyMinutes = $1 % 100;
 	    }
+	    yySeconds = 0;
+	    yyMeridian = MER24;
 	}
-	;
+    }
+;
 
 o_merid : /* NULL */ {
-	    $$ = MER24;
-	}
-	| tMERIDIAN {
-	    $$ = $1;
-	}
-	;
+            $$ = MER24;
+        }
+        | tMERIDIAN {
+            $$ = $1;
+        }
+        ;
 
 %%
+
 /*
  * 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, 0, 0 }
+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, 0, 0 }
+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 },
-    { NULL, 0, 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, 0, 0 }
+    {  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, 0, 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
-TclDateerror(
-    YYLTYPE* location,
-    DateInfo* infoPtr,
-    const char *s)
+yyerror(s)
+    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(
-    time_t Hours,
-    time_t Minutes,
-    time_t Seconds,
-    MERIDIAN Meridian)
+ToSeconds(Hours, Minutes, Seconds, Meridian)
+    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;
+        if (Hours < 1 || Hours > 12)
+            return -1;
+        return (((Hours % 12) + 12) * 60L + Minutes) * 60L + Seconds;
     }
-    return -1;			/* Should never be reached */
+    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
-LookupWord(
-    YYSTYPE* yylvalPtr,
-    char *buff)
+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;
+    }
+    *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;
+}
+
+static int
+LookupWord(buff)
+    char                *buff;
 {
     register char *p;
     register char *q;
-    register const TABLE *tp;
-    int i, abbrev;
+    register CONST TABLE *tp;
+    int i;
+    int abbrev;
 
     /*
      * Make it lowercase.
@@ -777,354 +885,273 @@ LookupWord(
     Tcl_UtfToLower(buff);
 
     if (strcmp(buff, "am") == 0 || strcmp(buff, "a.m.") == 0) {
-	yylvalPtr->Meridian = MERam;
-	return tMERIDIAN;
+        yylval.Meridian = MERam;
+        return tMERIDIAN;
     }
     if (strcmp(buff, "pm") == 0 || strcmp(buff, "p.m.") == 0) {
-	yylvalPtr->Meridian = MERpm;
-	return tMERIDIAN;
+        yylval.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) {
-		yylvalPtr->Number = tp->value;
-		return tp->type;
-	    }
-	} else if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        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;
+        }
     }
 
     for (tp = TimezoneTable; tp->name; tp++) {
-	if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        if (strcmp(buff, tp->name) == 0) {
+            yylval.Number = tp->value;
+            return tp->type;
+        }
     }
 
     for (tp = UnitsTable; tp->name; tp++) {
-	if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        if (strcmp(buff, tp->name) == 0) {
+            yylval.Number = tp->value;
+            return tp->type;
+        }
     }
 
     /*
      * Strip off any plural and try the units table again.
      */
-
     i = strlen(buff) - 1;
-    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;
-	    }
+    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;
+            }
 	}
     }
 
     for (tp = OtherTable; tp->name; tp++) {
-	if (strcmp(buff, tp->name) == 0) {
-	    yylvalPtr->Number = tp->value;
-	    return tp->type;
-	}
+        if (strcmp(buff, tp->name) == 0) {
+            yylval.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) {
-		yylvalPtr->Number = tp->value;
-		return tp->type;
-	    }
+	    && 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;
+            }
 	}
     }
 
     /*
      * 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) {
-		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;
+            }
 	}
     }
-
+    
     return tID;
 }
 
+
 static int
-TclDatelex(
-    YYSTYPE* yylvalPtr,
-    YYLTYPE* location,
-    DateInfo *info)
+yylex()
 {
-    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 (yylvalPtr->Number = 0;
-		    isdigit(UCHAR(c = *yyInput++)); ) {	  /* INTL: digit */
-		yylvalPtr->Number = 10 * yylvalPtr->Number + c - '0';
+            for (yylval.Number = 0;
+		    isdigit(UCHAR(c = *yyInput++)); ) { /* INTL: digit */
+                yylval.Number = 10 * yylval.Number + c - '0';
 		Count++;
 	    }
-	    yyInput--;
-	    yyDigitCount = Count;
-
-	    /*
-	     * A number with 6 or more digits is considered an ISO 8601 base.
-	     */
-
+            yyInput--;
+	    /* 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--;
-	    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;
+            *p = '\0';
+            yyInput--;
+            return LookupWord(buff);
+        }
+        if (c != '(') {
+            return *yyInput++;
+	}
+        Count = 0;
+        do {
+            c = *yyInput++;
+            if (c == '\0') {
+                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
-TclClockOldscanObjCmd(
-    ClientData clientData,	/* Unused */
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    int objc,			/* Count of paraneters */
-    Tcl_Obj *const *objv)	/* Parameters */
+TclGetDate(p, now, zone, timePtr)
+    char *p;
+    Tcl_WideInt now;
+    long zone;
+    Tcl_WideInt *timePtr;
 {
-    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;
+    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;
     }
-
-    yyInput = Tcl_GetString( objv[1] );
-    dateInfo.dateStart = yyInput;
+    yyHour = 0;
+    yyMinutes = 0;
+    yySeconds = 0;
+    yyMeridian = MER24;
+    yyRelSeconds = 0;
+    yyRelMonth = 0;
+    yyRelDay = 0;
+    yyRelPointer = NULL;
 
     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;
-    }
-    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;
-
+    yyHaveOrdinalMonth = 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);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
-	return TCL_ERROR;
-    } else if (status == 2) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
-	Tcl_DecrRefCount(dateInfo.messages);
-	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	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);
-	Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
-	return TCL_ERROR;
-    }
-    Tcl_DecrRefCount(dateInfo.messages);
-
-    if (yyHaveDate > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one date in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
-    }
-    if (yyHaveTime > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one time of day in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
-    }
-    if (yyHaveZone > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one time zone in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
-    }
-    if (yyHaveDay > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one weekday in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
-    }
-    if (yyHaveOrdinalMonth > 1) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj("more than one ordinal month in string", -1));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
-	return TCL_ERROR;
-    }
+    yyHaveTime = 0;
+    yyHaveZone = 0;
 
-    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));
+    if (yyparse() || yyHaveTime > 1 || yyHaveZone > 1 || yyHaveDate > 1 ||
+	    yyHaveDay > 1 || yyHaveOrdinalMonth > 1) {
+        return -1;
     }
-    Tcl_ListObjAppendElement(interp, result, resultElement);
-
-    if (yyHaveTime) {
-	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
-		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
+    
+    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 {
-	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
+        Start = (time_t) now;
+        if (!yyHaveRel) {
+            Start -= ((tm->tm_hour * 60L * 60L) +
+		    tm->tm_min * 60L) +	tm->tm_sec;
+	}
     }
 
-    resultElement = Tcl_NewObj();
-    if (yyHaveZone) {
-	Tcl_ListObjAppendElement(interp, resultElement,
-		Tcl_NewIntObj((int) -yyTimezone));
-	Tcl_ListObjAppendElement(interp, resultElement,
-		Tcl_NewIntObj(1 - yyDSTmode));
+    Start += yyRelSeconds;
+    if (RelativeMonth(Start, yyRelMonth, &Time) < 0) {
+        return -1;
     }
-    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);
+    Start += Time;
 
-    resultElement = Tcl_NewObj();
+    if (RelativeDay(Start, yyRelDay, &Time) < 0) {
+	return -1;
+    }
+    Start += Time;
+    
     if (yyHaveDay && !yyHaveDate) {
-	Tcl_ListObjAppendElement(interp, resultElement,
-		Tcl_NewIntObj((int) yyDayOrdinal));
-	Tcl_ListObjAppendElement(interp, resultElement,
-		Tcl_NewIntObj((int) yyDayNumber));
+        tod = NamedDay(Start, yyDayOrdinal, yyDayNumber);
+        Start += tod;
     }
-    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));
+	tod = NamedMonth(Start, yyMonthOrdinal, yyMonth);
+	Start += tod;
     }
-    Tcl_ListObjAppendElement(interp, result, resultElement);
-
-    Tcl_SetObjResult(interp, result);
-    return TCL_OK;
+    
+    *timePtr = Start;
+    return 0;
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 90be511..3eaf395 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,69 +17,89 @@
  * Prevent macros from clashing with function definitions.
  */
 
-#undef Tcl_FindHashEntry
-#undef Tcl_CreateHashEntry
+#if TCL_PRESERVE_BINARY_COMPATABILITY
+#   undef Tcl_FindHashEntry
+#   undef Tcl_CreateHashEntry
+#endif
 
 /*
- * 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) \
-    ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
+    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
 
 /*
  * Prototypes for the array hash key methods.
  */
 
-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);
+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));
 
 /*
- * Prototypes for the one word hash key methods. Not actually declared because
- * this is a critical path that is implemented in the core hash table access
- * function.
+ * Prototypes for the one word hash key methods.
  */
 
 #if 0
-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);
+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));
 #endif
 
 /*
  * Prototypes for the string hash key methods.
  */
 
-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);
+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));
 
 /*
- * Function prototypes for static functions in this file:
+ * Procedure prototypes for static procedures in this file:
  */
 
-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);
+#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
 
-const Tcl_HashKeyType tclArrayHashKeyType = {
+static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
+
+Tcl_HashKeyType tclArrayHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,		/* version */
     TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
     HashArrayKey,			/* hashKeyProc */
@@ -88,7 +108,7 @@ const Tcl_HashKeyType tclArrayHashKeyType = {
     NULL				/* freeEntryProc */
 };
 
-const Tcl_HashKeyType tclOneWordHashKeyType = {
+Tcl_HashKeyType tclOneWordHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,		/* version */
     0,					/* flags */
     NULL, /* HashOneWordKey, */		/* hashProc */
@@ -97,7 +117,7 @@ const Tcl_HashKeyType tclOneWordHashKeyType = {
     NULL  /* FreeOneWordKey, */		/* freeEntryProc */
 };
 
-const Tcl_HashKeyType tclStringHashKeyType = {
+Tcl_HashKeyType tclStringHashKeyType = {
     TCL_HASH_KEY_TYPE_VERSION,		/* version */
     0,					/* flags */
     HashStringKey,			/* hashKeyProc */
@@ -105,14 +125,15 @@ const 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.
@@ -124,23 +145,22 @@ const Tcl_HashKeyType tclStringHashKeyType = {
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_InitHashTable
 void
-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. */
+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. */
 {
     /*
-     * 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, (const Tcl_HashKeyType *) -1);
+    Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
 }
 
 /*
@@ -148,9 +168,9 @@ Tcl_InitHashTable(
  *
  * 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.
@@ -163,19 +183,19 @@ Tcl_InitHashTable(
  */
 
 void
-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. */
-    const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
-				 * behaviour of this table. */
+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. */
 {
 #if (TCL_SMALL_HASH_TABLE != 4)
-    Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4",
+    panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
 	    TCL_SMALL_HASH_TABLE);
 #endif
 
@@ -188,6 +208,7 @@ Tcl_InitCustomHashTable(
     tablePtr->downShift = 28;
     tablePtr->mask = 3;
     tablePtr->keyType = keyType;
+#if TCL_PRESERVE_BINARY_COMPATABILITY
     tablePtr->findProc = FindHashEntry;
     tablePtr->createProc = CreateHashEntry;
 
@@ -198,16 +219,41 @@ Tcl_InitCustomHashTable(
 	 */
     } 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.
+	 * 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.
+	 */
+	Tcl_Panic ("Hash table is not compatible");
     }
+    tablePtr->typePtr = typePtr;
+#endif
 }
 
 /*
@@ -218,8 +264,8 @@ Tcl_InitCustomHashTable(
  *	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.
@@ -228,36 +274,104 @@ Tcl_InitCustomHashTable(
  */
 
 Tcl_HashEntry *
-Tcl_FindHashEntry(
-    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const void *key)		/* Key to use to find matching entry. */
+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
 {
-    return (*((tablePtr)->findProc))(tablePtr, key);
+    return tablePtr->findProc(tablePtr, key);
 }
 
 static Tcl_HashEntry *
-FindHashEntry(
-    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const char *key)		/* Key to use to find matching entry. */
+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 */
 {
-    return CreateHashEntry(tablePtr, key, NULL);
-}
+    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;
+}
 
 /*
  *----------------------------------------------------------------------
  *
  * 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.
@@ -266,50 +380,60 @@ FindHashEntry(
  */
 
 Tcl_HashEntry *
-Tcl_CreateHashEntry(
-    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const void *key,		/* Key to use to find or create matching
+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
 				 * 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. */
+#if TCL_PRESERVE_BINARY_COMPATABILITY
 {
-    return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
+    return tablePtr->createProc(tablePtr, key, newPtr);
 }
 
 static Tcl_HashEntry *
-CreateHashEntry(
-    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const char *key,		/* Key to use to find or create matching
+CreateHashEntry(tablePtr, key, newPtr)
+    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. */
+#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */
 {
     register Tcl_HashEntry *hPtr;
-    const Tcl_HashKeyType *typePtr;
+    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);
+	    index = RANDOM_INDEX (tablePtr, hash);
 	} else {
 	    index = hash & tablePtr->mask;
 	}
     } else {
-	hash = PTR2UINT(key);
-	index = RANDOM_INDEX(tablePtr, hash);
+	hash = (unsigned int) key;
+	index = RANDOM_INDEX (tablePtr, hash);
     }
 
     /*
@@ -318,70 +442,65 @@ CreateHashEntry(
 
     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 != PTR2UINT(hPtr->hash)) {
+	    if (hash != (unsigned int) hPtr->hash) {
 		continue;
 	    }
 #endif
-	    if (compareKeysProc((void *) key, hPtr)) {
-		if (newPtr) {
-		    *newPtr = 0;
-		}
+	    if (compareKeysProc ((VOID *) key, hPtr)) {
+		*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 != PTR2UINT(hPtr->hash)) {
+	    if (hash != (unsigned int) hPtr->hash) {
 		continue;
 	    }
 #endif
 	    if (key == hPtr->key.oneWordValue) {
-		if (newPtr) {
-		    *newPtr = 0;
-		}
+		*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 = ckalloc(sizeof(Tcl_HashEntry));
+	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
-    hPtr->hash = UINT2PTR(hash);
+#   if TCL_PRESERVE_BINARY_COMPATABILITY
+    hPtr->hash = (VOID *) hash;
+#   else
+    hPtr->hash = hash;
+#   endif
     hPtr->nextPtr = tablePtr->buckets[index];
     tablePtr->buckets[index] = hPtr;
 #else
-    hPtr->bucketPtr = &tablePtr->buckets[index];
+    hPtr->bucketPtr = &(tablePtr->buckets[index]);
     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) {
@@ -401,19 +520,20 @@ CreateHashEntry(
  *	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(
-    Tcl_HashEntry *entryPtr)
+Tcl_DeleteHashEntry(entryPtr)
+    Tcl_HashEntry *entryPtr;
 {
     register Tcl_HashEntry *prevPtr;
-    const Tcl_HashKeyType *typePtr;
+    Tcl_HashKeyType *typePtr;
     Tcl_HashTable *tablePtr;
     Tcl_HashEntry **bucketPtr;
 #if TCL_HASH_KEY_STORE_HASH
@@ -422,26 +542,30 @@ Tcl_DeleteHashEntry(
 
     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, PTR2INT(entryPtr->hash));
+	|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
+	index = RANDOM_INDEX (tablePtr, entryPtr->hash);
     } else {
-	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
+	index = ((unsigned int) entryPtr->hash) & tablePtr->mask;
     }
 
-    bucketPtr = &tablePtr->buckets[index];
+    bucketPtr = &(tablePtr->buckets[index]);
 #else
     bucketPtr = entryPtr->bucketPtr;
 #endif
@@ -451,7 +575,7 @@ Tcl_DeleteHashEntry(
     } else {
 	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
 	    if (prevPtr == NULL) {
-		Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry");
+		panic("malformed bucket chain in Tcl_DeleteHashEntry");
 	    }
 	    if (prevPtr->nextPtr == entryPtr) {
 		prevPtr->nextPtr = entryPtr->nextPtr;
@@ -462,9 +586,9 @@ Tcl_DeleteHashEntry(
 
     tablePtr->numEntries--;
     if (typePtr->freeEntryProc) {
-	typePtr->freeEntryProc(entryPtr);
+	typePtr->freeEntryProc (entryPtr);
     } else {
-	ckfree(entryPtr);
+	ckfree((char *) entryPtr);
     }
 }
 
@@ -473,8 +597,8 @@ Tcl_DeleteHashEntry(
  *
  * 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.
@@ -486,23 +610,27 @@ Tcl_DeleteHashEntry(
  */
 
 void
-Tcl_DeleteHashTable(
-    register Tcl_HashTable *tablePtr)	/* Table to delete. */
+Tcl_DeleteHashTable(tablePtr)
+    register Tcl_HashTable *tablePtr;		/* Table to delete. */
 {
     register Tcl_HashEntry *hPtr, *nextPtr;
-    const Tcl_HashKeyType *typePtr;
+    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.
@@ -513,9 +641,9 @@ Tcl_DeleteHashTable(
 	while (hPtr != NULL) {
 	    nextPtr = hPtr->nextPtr;
 	    if (typePtr->freeEntryProc) {
-		typePtr->freeEntryProc(hPtr);
+		typePtr->freeEntryProc (hPtr);
 	    } else {
-		ckfree(hPtr);
+		ckfree((char *) hPtr);
 	    }
 	    hPtr = nextPtr;
 	}
@@ -526,11 +654,7 @@ Tcl_DeleteHashTable(
      */
 
     if (tablePtr->buckets != tablePtr->staticBuckets) {
-	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
-	    TclpSysFree((char *) tablePtr->buckets);
-	} else {
-	    ckfree(tablePtr->buckets);
-	}
+	ckfree((char *) tablePtr->buckets);
     }
 
     /*
@@ -538,8 +662,12 @@ Tcl_DeleteHashTable(
      * re-initialization.
      */
 
+#if TCL_PRESERVE_BINARY_COMPATABILITY
     tablePtr->findProc = BogusFind;
     tablePtr->createProc = BogusCreate;
+#else
+    tablePtr->typePtr = NULL;
+#endif
 }
 
 /*
@@ -547,14 +675,16 @@ Tcl_DeleteHashTable(
  *
  * 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.
@@ -563,10 +693,10 @@ Tcl_DeleteHashTable(
  */
 
 Tcl_HashEntry *
-Tcl_FirstHashEntry(
-    Tcl_HashTable *tablePtr,	/* Table to search. */
-    Tcl_HashSearch *searchPtr)	/* Place to store information about progress
-				 * through the table. */
+Tcl_FirstHashEntry(tablePtr, searchPtr)
+    Tcl_HashTable *tablePtr;		/* Table to search. */
+    Tcl_HashSearch *searchPtr;		/* Place to store information about
+					 * progress through the table. */
 {
     searchPtr->tablePtr = tablePtr;
     searchPtr->nextIndex = 0;
@@ -580,12 +710,12 @@ Tcl_FirstHashEntry(
  * Tcl_NextHashEntry --
  *
  *	Once a hash table enumeration has been initiated by calling
- *	Tcl_FirstHashEntry, this function may be called to return successive
- *	elements of the table.
+ *	Tcl_FirstHashEntry, this procedure 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.
@@ -594,12 +724,11 @@ Tcl_FirstHashEntry(
  */
 
 Tcl_HashEntry *
-Tcl_NextHashEntry(
-    register Tcl_HashSearch *searchPtr)
-				/* Place to store information about progress
-				 * through the table. Must have been
-				 * initialized by calling
-				 * Tcl_FirstHashEntry. */
+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_HashEntry *hPtr;
     Tcl_HashTable *tablePtr = searchPtr->tablePtr;
@@ -622,12 +751,13 @@ Tcl_NextHashEntry(
  *
  * 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.
@@ -636,8 +766,8 @@ Tcl_NextHashEntry(
  */
 
 char *
-Tcl_HashStats(
-    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
+Tcl_HashStats(tablePtr)
+    Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
 {
 #define NUM_COUNTERS 10
     int count[NUM_COUNTERS], overflow, i, j;
@@ -665,16 +795,14 @@ Tcl_HashStats(
 	    overflow++;
 	}
 	tmp = j;
-	if (tablePtr->numEntries != 0) {
-	    average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
-	}
+	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
     }
 
     /*
      * Print out the histogram and a few other pieces of information.
      */
 
-    result = ckalloc((NUM_COUNTERS * 60) + 300);
+    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);
@@ -707,9 +835,9 @@ Tcl_HashStats(
  */
 
 static Tcl_HashEntry *
-AllocArrayEntry(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key to store in the hash table entry. */
+AllocArrayEntry(tablePtr, keyPtr)
+    Tcl_HashTable *tablePtr;	/* Hash table. */
+    VOID *keyPtr;		/* Key to store in the hash table entry. */
 {
     int *array = (int *) keyPtr;
     register int *iPtr1, *iPtr2;
@@ -720,16 +848,14 @@ AllocArrayEntry(
     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 = ckalloc(size);
+    hPtr = (Tcl_HashEntry *) ckalloc(size);
 
     for (iPtr1 = array, iPtr2 = hPtr->key.words;
 	    count > 0; count--, iPtr1++, iPtr2++) {
 	*iPtr2 = *iPtr1;
     }
-    hPtr->clientData = 0;
 
     return hPtr;
 }
@@ -742,8 +868,8 @@ AllocArrayEntry(
  *	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.
@@ -752,12 +878,12 @@ AllocArrayEntry(
  */
 
 static int
-CompareArrayKeys(
-    void *keyPtr,		/* New key to compare. */
-    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
+CompareArrayKeys(keyPtr, hPtr)
+    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;
 
@@ -777,8 +903,8 @@ CompareArrayKeys(
  *
  * 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
@@ -791,11 +917,11 @@ CompareArrayKeys(
  */
 
 static unsigned int
-HashArrayKey(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key from which to compute hash value. */
+HashArrayKey(tablePtr, keyPtr)
+    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;
 
@@ -823,11 +949,11 @@ HashArrayKey(
  */
 
 static Tcl_HashEntry *
-AllocStringEntry(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key to store in the hash table entry. */
+AllocStringEntry(tablePtr, keyPtr)
+    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;
 
@@ -835,9 +961,8 @@ AllocStringEntry(
     if (size < sizeof(hPtr->key)) {
 	allocsize = sizeof(hPtr->key);
     }
-    hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize);
+    hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
     memcpy(hPtr->key.string, string, size);
-    hPtr->clientData = 0;
     return hPtr;
 }
 
@@ -849,8 +974,8 @@ AllocStringEntry(
  *	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.
@@ -859,14 +984,22 @@ AllocStringEntry(
  */
 
 static int
-CompareStringKeys(
-    void *keyPtr,		/* New key to compare. */
-    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
+CompareStringKeys(keyPtr, hPtr)
+    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;
 
-    return !strcmp(p1, p2);
+    for (;; p1++, p2++) {
+	if (*p1 != *p2) {
+	    break;
+	}
+	if (*p1 == '\0') {
+	    return 1;
+	}
+    }
+    return 0;
 }
 
 /*
@@ -874,11 +1007,12 @@ CompareStringKeys(
  *
  * 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.
@@ -886,65 +1020,55 @@ CompareStringKeys(
  *----------------------------------------------------------------------
  */
 
-static unsigned
-HashStringKey(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key from which to compute hash value. */
+static unsigned int
+HashStringKey(tablePtr, keyPtr)
+    Tcl_HashTable *tablePtr;	/* Hash table. */
+    VOID *keyPtr;		/* Key from which to compute hash value. */
 {
-    register const char *string = keyPtr;
+    register CONST char *string = (CONST char *) keyPtr;
     register unsigned int result;
-    register char c;
+    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:
-     *
-     * 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.
-     *
-     * Note that this function is very weak against malicious strings; it's
-     * very easy to generate multiple keys that have the same hashcode. On the
-     * other hand, that hardly ever actually occurs and this function *is*
-     * very cheap, even by comparison with industry-standard hashes like FNV.
-     * If real strength of hash is required though, use a custom hash based on
-     * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
-     * Since Tcl command and namespace names are usually reasonably-named (the
-     * main use for string hashes in modern Tcl) speed is far more important
-     * than strength.
+     * 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:
      *
-     * See also HashString in tclLiteral.c.
-     * See also TclObjHashKey in tclObj.c.
-     *
-     * See [tcl-Feature Request #2958832]
+     * 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.
      */
 
-    if ((result = UCHAR(*string)) != 0) {
-	while ((c = *++string) != 0) {
-	    result += (result << 3) + UCHAR(c);
+    result = 0;
+    while (1) {
+	c = *string;
+	if (c == 0) {
+	    break;
 	}
+	result += (result<<3) + c;
+	string++;
     }
     return result;
 }
 
+#if TCL_PRESERVE_BINARY_COMPATABILITY
 /*
  *----------------------------------------------------------------------
  *
  * BogusFind --
  *
- *	This function is invoked when an Tcl_FindHashEntry is called on a
- *	table that has been deleted.
+ *	This procedure is invoked when an Tcl_FindHashEntry is called
+ *	on a table that has been deleted.
  *
  * Results:
- *	If Tcl_Panic returns (which it shouldn't) this function returns NULL.
+ *	If panic returns (which it shouldn't) this procedure returns
+ *	NULL.
  *
  * Side effects:
  *	Generates a panic.
@@ -954,11 +1078,11 @@ HashStringKey(
 
 	/* ARGSUSED */
 static Tcl_HashEntry *
-BogusFind(
-    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const char *key)		/* Key to use to find matching entry. */
+BogusFind(tablePtr, key)
+    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
+    CONST char *key;		/* Key to use to find matching entry. */
 {
-    Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry");
+    panic("called Tcl_FindHashEntry on deleted table");
     return NULL;
 }
 
@@ -967,11 +1091,12 @@ BogusFind(
  *
  * BogusCreate --
  *
- *	This function is invoked when an Tcl_CreateHashEntry is called on a
- *	table that has been deleted.
+ *	This procedure is invoked when an Tcl_CreateHashEntry is called
+ *	on a table that has been deleted.
  *
  * Results:
- *	If panic returns (which it shouldn't) this function returns NULL.
+ *	If panic returns (which it shouldn't) this procedure returns
+ *	NULL.
  *
  * Side effects:
  *	Generates a panic.
@@ -981,72 +1106,59 @@ BogusFind(
 
 	/* ARGSUSED */
 static Tcl_HashEntry *
-BogusCreate(
-    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
-    const char *key,		/* Key to use to find or create matching
+BogusCreate(tablePtr, key, newPtr)
+    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. */
 {
-    Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry");
+    panic("called Tcl_CreateHashEntry on deleted table");
     return NULL;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
  *
  * RebuildTable --
  *
- *	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.
+ *	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.
  *
  * 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(
-    register Tcl_HashTable *tablePtr)	/* Table to enlarge. */
+RebuildTable(tablePtr)
+    register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
 {
     int oldSize, count, index;
     Tcl_HashEntry **oldBuckets;
     register Tcl_HashEntry **oldChainPtr, **newChainPtr;
     register Tcl_HashEntry *hPtr;
-    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;
-    }
+    Tcl_HashKeyType *typePtr;
 
     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;
-    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
-	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
-		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
-    } else {
-	tablePtr->buckets =
-		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
-    }
+    tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
+	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
 	    count > 0; count--, newChainPtr++) {
 	*newChainPtr = NULL;
@@ -1055,6 +1167,21 @@ RebuildTable(
     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.
      */
@@ -1062,32 +1189,31 @@ RebuildTable(
     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, PTR2INT(hPtr->hash));
+		|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
+		index = RANDOM_INDEX (tablePtr, hPtr->hash);
 	    } else {
-		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
+		index = ((unsigned int) hPtr->hash) & tablePtr->mask;
 	    }
 	    hPtr->nextPtr = tablePtr->buckets[index];
 	    tablePtr->buckets[index] = hPtr;
 #else
-	    void *key = Tcl_GetHashKey(tablePtr, hPtr);
-
+	    VOID *key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
 	    if (typePtr->hashKeyProc) {
 		unsigned int hash;
-
-		hash = typePtr->hashKeyProc(tablePtr, key);
+		hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
 		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
-		    index = RANDOM_INDEX(tablePtr, hash);
+		    index = RANDOM_INDEX (tablePtr, hash);
 		} else {
 		    index = hash & tablePtr->mask;
 		}
 	    } else {
-		index = RANDOM_INDEX(tablePtr, key);
+		index = RANDOM_INDEX (tablePtr, key);
 	    }
 
-	    hPtr->bucketPtr = &tablePtr->buckets[index];
+	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
 	    hPtr->nextPtr = *hPtr->bucketPtr;
 	    *hPtr->bucketPtr = hPtr;
 #endif
@@ -1099,18 +1225,6 @@ RebuildTable(
      */
 
     if (oldBuckets != tablePtr->staticBuckets) {
-	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
-	    TclpSysFree((char *) oldBuckets);
-	} else {
-	    ckfree(oldBuckets);
-	}
+	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 b10d423..9ff3f49 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,29 +9,13 @@
  * 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"
 
-/*
- * Type of the assocData structure used to hold the reference to the [history
- * add] subcommand, used in Tcl_RecordAndEvalObj.
- */
-
-typedef struct {
-    Tcl_Obj *historyObj;	/* == "::history" */
-    Tcl_Obj *addObj;		/* == "add" */
-} HistoryObjs;
-
-#define HISTORY_OBJS_KEY	"::tcl::HistoryObjs"
-
-/*
- * Static functions in this file.
- */
-
-static Tcl_InterpDeleteProc DeleteHistoryObjs;
 
 /*
  *----------------------------------------------------------------------
@@ -39,7 +23,8 @@ static Tcl_InterpDeleteProc DeleteHistoryObjs;
  * 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
@@ -52,12 +37,12 @@ static Tcl_InterpDeleteProc DeleteHistoryObjs;
  */
 
 int
-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_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_EVAL_GLOBAL means use Tcl_GlobalEval
 				 * instead of Tcl_Eval. */
 {
@@ -75,17 +60,18 @@ Tcl_RecordAndEval(
 	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.
 	 */
 
-	(void) Tcl_GetStringResult(interp);
+	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	        TCL_VOLATILE);
 
 	/*
 	 * 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.
@@ -117,69 +103,33 @@ Tcl_RecordAndEval(
  */
 
 int
-Tcl_RecordAndEvalObj(
-    Tcl_Interp *interp,		/* Token for interpreter in which command will
-				 * be executed. */
-    Tcl_Obj *cmdPtr,		/* Points to object holding the command to
+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
 				 * 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, call = 1;
-    Tcl_CmdInfo info;
-    HistoryObjs *histObjsPtr =
-	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
+    int result;
+    Tcl_Obj *list[3];
+    register Tcl_Obj *objPtr;
 
     /*
-     * Create the references to the [::history add] command if necessary.
+     * Do recording by eval'ing a tcl history command: history add $cmd.
      */
 
-    if (histObjsPtr == NULL) {
-	histObjsPtr = ckalloc(sizeof(HistoryObjs));
-	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
-	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
-	Tcl_IncrRefCount(histObjsPtr->historyObj);
-	Tcl_IncrRefCount(histObjsPtr->addObj);
-	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
-		histObjsPtr);
-    }
-
-    /*
-     * Do not call [history] if it has been replaced by an empty proc
-     */
-
-    result = Tcl_GetCommandInfo(interp, "::history", &info);
-    if (result && (info.deleteProc == TclProcDeleteProc)) {
-	Proc *procPtr = (Proc *) info.objClientData;
-	call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
-    }
-
-    if (call) {
-	Tcl_Obj *list[3];
-
-	/*
-	 * Do recording by eval'ing a tcl history command: history add $cmd. 
-	 */
-
-	list[0] = histObjsPtr->historyObj;
-	list[1] = histObjsPtr->addObj;
-	list[2] = cmdPtr;
-
-	Tcl_IncrRefCount(cmdPtr);
-	(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
-	Tcl_DecrRefCount(cmdPtr);
-
-	/*
-	 * One possible failure mode above: exceeding a resource limit.
-	 */
-	
-	if (Tcl_LimitExceeded(interp)) {
-	    return TCL_ERROR;
-	}
-    }
+    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);
 
     /*
      * Execute the command.
@@ -191,40 +141,3 @@ Tcl_RecordAndEvalObj(
     }
     return result;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * DeleteHistoryObjs --
- *
- *	Called to delete the references to the constant words used when adding
- *	to the history.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The constant words may be deleted.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DeleteHistoryObjs(
-    ClientData clientData,
-    Tcl_Interp *interp)
-{
-    register HistoryObjs *histObjsPtr = clientData;
-
-    TclDecrRefCount(histObjsPtr->historyObj);
-    TclDecrRefCount(histObjsPtr->addObj);
-    ckfree(histObjsPtr);
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclIO.c b/generic/tclIO.c
index b06c14d..a1d5447 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,38 +7,64 @@
  * 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;
-				/* 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. */
+
+    /*
+     * 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;
     int stdinInitialized;
-    Tcl_Channel stdoutChannel;	/* Static variable for the stdout channel. */
+    Tcl_Channel stdoutChannel;
     int stdoutInitialized;
-    Tcl_Channel stderrChannel;	/* Static variable for the stderr channel. */
+    Tcl_Channel stderrChannel;
     int stderrInitialized;
-    Tcl_Encoding binaryEncoding;
+
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
@@ -47,189 +73,88 @@ static Tcl_ThreadDataKey dataKey;
  * Static functions in this file:
  */
 
-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 int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
-			    int errorCode, int flags);
-static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
-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, int allowShortReads);
-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);
-static int              WillRead(Channel *chanPtr);
-
-/*
- * 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))
-#define GotFlag(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 const 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.otherValuePtr)
-#define SET_CHANNELSTATE(objPtr, storePtr) \
-    ((objPtr)->internalRep.otherValuePtr = (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) \
+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));
+
+#define BUSY_STATE(st,fl) \
      ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
       (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
 
@@ -238,117 +163,10 @@ static const Tcl_ObjType tclChannelType = {
 /*
  *---------------------------------------------------------------------------
  *
- * ChanClose, ChanRead, ChanSeek, ChanThreadAction, ChanWatch, ChanWrite --
- *
- *	Simplify the access to selected channel driver "methods" that are used
- *	in multiple places in a stereotypical fashion. These are just thin
- *	wrappers around the driver functions.
- *
- *---------------------------------------------------------------------------
- */
-
-static inline int
-ChanClose(
-    Channel *chanPtr,
-    Tcl_Interp *interp)
-{
-    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
-	return chanPtr->typePtr->closeProc(chanPtr->instanceData, interp);
-    } else {
-	return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
-    }
-}
-
-static inline int
-ChanCloseHalf(
-    Channel *chanPtr,
-    Tcl_Interp *interp,
-    int flags)
-{
-    return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, flags);
-}
-
-static inline int
-ChanRead(
-    Channel *chanPtr,
-    char *dst,
-    int dstSize,
-    int *errnoPtr)
-{
-    if (WillRead(chanPtr) < 0) {
-        return -1;
-    }
-
-    return chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize,
-	    errnoPtr);
-}
-
-static inline Tcl_WideInt
-ChanSeek(
-    Channel *chanPtr,
-    Tcl_WideInt offset,
-    int mode,
-    int *errnoPtr)
-{
-    /*
-     * Note that we prefer the wideSeekProc if that field is available in the
-     * type and non-NULL.
-     */
-
-    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
-	    chanPtr->typePtr->wideSeekProc != NULL) {
-	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
-		offset, mode, errnoPtr);
-    }
-
-    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
-	*errnoPtr = EOVERFLOW;
-	return Tcl_LongAsWide(-1);
-    }
-
-    return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
-	    Tcl_WideAsLong(offset), mode, errnoPtr));
-}
-
-static inline void
-ChanThreadAction(
-    Channel *chanPtr,
-    int action)
-{
-    Tcl_DriverThreadActionProc *threadActionProc =
-	    Tcl_ChannelThreadActionProc(chanPtr->typePtr);
-
-    if (threadActionProc != NULL) {
-	threadActionProc(chanPtr->instanceData, action);
-    }
-}
-
-static inline void
-ChanWatch(
-    Channel *chanPtr,
-    int mask)
-{
-    chanPtr->typePtr->watchProc(chanPtr->instanceData, mask);
-}
-
-static inline int
-ChanWrite(
-    Channel *chanPtr,
-    const char *src,
-    int srcLen,
-    int *errnoPtr)
-{
-    return chanPtr->typePtr->outputProc(chanPtr->instanceData, src, srcLen,
-	    errnoPtr);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
  * TclInitIOSubsystem --
  *
  *	Initialize all resources used by this subsystem on a per-process
- *	basis.
+ *	basis.  
  *
  * Results:
  *	None.
@@ -360,24 +178,23 @@ ChanWrite(
  */
 
 void
-TclInitIOSubsystem(void)
+TclInitIOSubsystem()
 {
     /*
-     * 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-process 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-thread
+ *	basis.  Closes all extant channels that have not already been 
+ *	closed because they were not owned by any interp.  
  *
  * Results:
  *	None.
@@ -396,108 +213,94 @@ TclFinalizeIOSubsystem(void)
     Channel *chanPtr = NULL;	/* Iterates over open channels. */
     ChannelState *statePtr;	/* State of channel stack */
     int active = 1;		/* Flag == 1 while there's still work to do */
-    int doflushnb;
-
-    /* Fetch the pre-TIP#398 compatibility flag */ 
-    {
-        const char *s;
-        Tcl_DString ds;
-        
-        s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
-        doflushnb = ((s != NULL) && strcmp(s, "0"));
-        if (s != NULL) {
-            Tcl_DStringFree(&ds);
-        }
-    }
 
     /*
-     * 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 (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED | CHANNEL_DEAD)
-                || (doflushnb && GotFlag(statePtr, BG_FLUSH_SCHEDULED))) {
+	    if (!(statePtr->flags & (CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD))) {
 		active = 1;
 		break;
 	    }
 	}
 
 	/*
-	 * We've found a live channel. Close it.
+	 * We've found a live channel.  Close it.
 	 */
 
 	if (active) {
 
 	    /*
-	     * TIP #398:  by default, we no  longer set the  channel back into
-             * blocking  mode.  To  restore  the old  blocking  behavior,  the
-             * environment variable  TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
-             * and not be "0".
+	     * Set the channel back into blocking mode to ensure that we 
+	     * wait for all data to flush out.
 	     */
-            if (doflushnb) {
-                    /* 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");                    
-            }
-
+	    
+	    (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
+					"-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.
 		 */
-
-                ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
+		
 		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.
 		 */
-
-		(void) ChanClose(chanPtr, NULL);
-
+		
+		if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+		    (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
+		} else {
+		    (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
+						   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;
-		SetFlag(statePtr, CHANNEL_DEAD);
+		statePtr->flags |= CHANNEL_DEAD;
 	    }
 	}
     }
@@ -505,14 +308,15 @@ 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
@@ -524,25 +328,24 @@ TclFinalizeIOSubsystem(void)
  */
 
 void
-Tcl_SetStdChannel(
-    Tcl_Channel channel,
-    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+Tcl_SetStdChannel(channel, type)
+    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;
     }
 }
 
@@ -557,67 +360,71 @@ Tcl_SetStdChannel(
  *	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(
-    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
+Tcl_GetStdChannel(type)
+    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;
-
-	    /*
-	     * 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.
-	     */
+	case TCL_STDIN:
+	    if (!tsdPtr->stdinInitialized) {
+		tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
+		tsdPtr->stdinInitialized = 1;
 
-	    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;
+		/*
+                 * 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;
     }
     return channel;
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -631,25 +438,27 @@ Tcl_GetStdChannel(
  *	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(
-    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(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. */
 {
-    ChannelState *statePtr = ((Channel *) chan)->state;
+    ChannelState *statePtr;
     CloseCallback *cbPtr;
 
-    cbPtr = ckalloc(sizeof(CloseCallback));
+    statePtr = ((Channel *) chan)->state;
+
+    cbPtr = (CloseCallback *) ckalloc((unsigned) sizeof(CloseCallback));
     cbPtr->proc = proc;
     cbPtr->clientData = clientData;
 
@@ -662,41 +471,45 @@ Tcl_CreateCloseHandler(
  *
  * 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(
-    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(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. */
 {
-    ChannelState *statePtr = ((Channel *) chan)->state;
+    ChannelState *statePtr;
     CloseCallback *cbPtr, *cbPrevPtr;
 
-    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(cbPtr);
-	    break;
-	}
-	cbPrevPtr = cbPtr;
+    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;
+        }
     }
 }
 
@@ -705,53 +518,58 @@ Tcl_DeleteCloseHandler(
  *
  * 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(
-    Tcl_Interp *interp)
+GetChannelTable(interp)
+    Tcl_Interp *interp;
 {
     Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_Channel stdinChan, stdoutChan, stderrChan;
 
-    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
-    if (hTblPtr == NULL) {
-	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
-	Tcl_SetAssocData(interp, "tclIO",
-		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);
+    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);
 
-	/*
-	 * If the interpreter is trusted (not "safe"), insert channels for
-	 * stdin, stdout and stderr (possibly creating them in the process).
-	 */
+        (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);
+            }
+        }
 
-	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;
 }
@@ -762,8 +580,9 @@ GetChannelTable(
  * 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.
@@ -777,9 +596,9 @@ GetChannelTable(
  */
 
 static void
-DeleteChannelTable(
-    ClientData clientData,	/* The per-interpreter data structure. */
-    Tcl_Interp *interp)		/* The interpreter being deleted. */
+DeleteChannelTable(clientData, interp)
+    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. */
@@ -787,64 +606,66 @@ DeleteChannelTable(
     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)) {
 
-    hTblPtr = clientData;
-    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
-	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
-	chanPtr = Tcl_GetHashValue(hPtr);
+        chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
 	statePtr = chanPtr->state;
 
-	/*
-	 * 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, sPtr);
-
-		TclDecrRefCount(sPtr->scriptPtr);
-		ckfree(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.
-	 */
+        /*
+         * 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;
+            }
+        }
 
-	Tcl_DeleteHashEntry(hPtr);
-	SetFlag(statePtr, CHANNEL_TAINTED);
-	statePtr->refCount--;
-	if (statePtr->refCount <= 0) {
-	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
-		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
-	    }
-	}
+        /*
+         * 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);
+            }
+        }
     }
     Tcl_DeleteHashTable(hTblPtr);
-    ckfree(hTblPtr);
+    ckfree((char *) hTblPtr);
 }
 
 /*
@@ -853,11 +674,11 @@ DeleteChannelTable(
  * 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.
@@ -870,30 +691,32 @@ DeleteChannelTable(
  */
 
 static void
-CheckForStdChannelsBeingClosed(
-    Tcl_Channel chan)
+CheckForStdChannelsBeingClosed(chan)
+    Tcl_Channel chan;
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
-    if ((chan == tsdPtr->stdinChannel) && tsdPtr->stdinInitialized) {
-	if (statePtr->refCount < 2) {
-	    statePtr->refCount = 0;
-	    tsdPtr->stdinChannel = NULL;
-	    return;
-	}
-    } else if ((chan == tsdPtr->stdoutChannel) && tsdPtr->stdoutInitialized) {
-	if (statePtr->refCount < 2) {
-	    statePtr->refCount = 0;
-	    tsdPtr->stdoutChannel = NULL;
-	    return;
-	}
-    } else if ((chan == tsdPtr->stderrChannel) && tsdPtr->stderrInitialized) {
-	if (statePtr->refCount < 2) {
-	    statePtr->refCount = 0;
-	    tsdPtr->stderrChannel = NULL;
-	    return;
-	}
+    if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
+        if (statePtr->refCount < 2) {
+            statePtr->refCount = 0;
+            tsdPtr->stdinChannel = NULL;
+            return;
+        }
+    } else if ((chan == tsdPtr->stdoutChannel)
+	    && (tsdPtr->stdoutInitialized)) {
+        if (statePtr->refCount < 2) {
+            statePtr->refCount = 0;
+            tsdPtr->stdoutChannel = NULL;
+            return;
+        }
+    } else if ((chan == tsdPtr->stderrChannel)
+	    && (tsdPtr->stderrInitialized)) {
+        if (statePtr->refCount < 2) {
+            statePtr->refCount = 0;
+            tsdPtr->stderrChannel = NULL;
+            return;
+        }
     }
 }
 
@@ -902,28 +725,27 @@ CheckForStdChannelsBeingClosed(
  *
  * 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(
-    Tcl_Channel chan)		/* Channel to check. */
+int 
+Tcl_IsStandardChannel(chan)
+    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;
@@ -936,8 +758,8 @@ Tcl_IsStandardChannel(
  * 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.
@@ -949,41 +771,41 @@ Tcl_IsStandardChannel(
  */
 
 void
-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_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_HashTable *hTblPtr;	/* Hash table of channels. */
     Tcl_HashEntry *hPtr;	/* Search variable. */
-    int isNew;			/* Is the hash entry new or does it exist? */
+    int new;			/* 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 == NULL) {
-	Tcl_Panic("Tcl_RegisterChannel: channel without name");
+    if (statePtr->channelName == (CONST char *) NULL) {
+        panic("Tcl_RegisterChannel: channel without name");
     }
-    if (interp != NULL) {
-	hTblPtr = GetChannelTable(interp);
-	hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &isNew);
-	if (!isNew) {
-	    if (chan == Tcl_GetHashValue(hPtr)) {
-		return;
-	    }
+    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;
+            }
 
-	    Tcl_Panic("Tcl_RegisterChannel: duplicate channel names");
-	}
-	Tcl_SetHashValue(hPtr, chanPtr);
+	    panic("Tcl_RegisterChannel: duplicate channel names");
+        }
+        Tcl_SetHashValue(hPtr, (ClientData) chanPtr);
     }
+
     statePtr->refCount++;
 }
 
@@ -994,19 +816,19 @@ Tcl_RegisterChannel(
  *
  *	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.
  *
@@ -1014,26 +836,27 @@ Tcl_RegisterChannel(
  */
 
 int
-Tcl_UnregisterChannel(
-    Tcl_Interp *interp,		/* Interpreter in which channel is defined. */
-    Tcl_Channel chan)		/* Channel to delete. */
+Tcl_UnregisterChannel(interp, chan)
+    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 (GotFlag(statePtr, CHANNEL_INCLOSE)) {
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "Illegal recursive call to close "
-		    "through close-handler of channel", NULL);
+ 
+    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);
 	}
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
-
+ 
     if (DetachChannel(interp, chan) != TCL_OK) {
-	return TCL_OK;
+        return TCL_OK;
     }
-
+    
     statePtr = ((Channel *) chan)->state->bottomChanPtr->state;
 
     /*
@@ -1051,31 +874,30 @@ Tcl_UnregisterChannel(
      */
 
     if (statePtr->refCount <= 0) {
-	/*
-	 * Ensure that if there is another buffer, it gets flushed whether or
-	 * not we are doing a background flush.
-	 */
 
-	if ((statePtr->curOutPtr != NULL) &&
-		IsBufferReady(statePtr->curOutPtr)) {
-	    SetFlag(statePtr, BUFFER_READY);
-	}
-	Tcl_Preserve(statePtr);
-	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
-	    /*
-	     * We don't want to re-enter Tcl_Close().
-	     */
+        /*
+         * Ensure that if there is another buffer, it gets flushed
+         * whether or not we are doing a background flush.
+         */
 
-	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
+        if ((statePtr->curOutPtr != NULL) &&
+                (statePtr->curOutPtr->nextAdded >
+                        statePtr->curOutPtr->nextRemoved)) {
+            statePtr->flags |= BUFFER_READY;
+        }
+	Tcl_Preserve((ClientData)statePtr);
+        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) {
-		    SetFlag(statePtr, CHANNEL_CLOSED);
-		    Tcl_Release(statePtr);
+		    statePtr->flags |= CHANNEL_CLOSED;
+		    Tcl_Release((ClientData)statePtr);
 		    return TCL_ERROR;
 		}
 	    }
-	}
-	SetFlag(statePtr, CHANNEL_CLOSED);
-	Tcl_Release(statePtr);
+        }
+        statePtr->flags |= CHANNEL_CLOSED;
+	Tcl_Release((ClientData)statePtr);
     }
     return TCL_OK;
 }
@@ -1087,42 +909,45 @@ Tcl_UnregisterChannel(
  *
  *	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(
-    Tcl_Interp *interp,		/* Interpreter in which channel is defined. */
-    Tcl_Channel chan)		/* Channel to delete. */
+Tcl_DetachChannel(interp, chan)
+    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);
 }
 
@@ -1133,26 +958,28 @@ Tcl_DetachChannel(
  *
  *	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(
-    Tcl_Interp *interp,		/* Interpreter in which channel is defined. */
-    Tcl_Channel chan)		/* Channel to delete. */
+DetachChannel(interp, chan)
+    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. */
@@ -1160,44 +987,43 @@ DetachChannel(
     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 != NULL) {
-	hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
-	if (hTblPtr == NULL) {
+    if (interp != (Tcl_Interp *) NULL) {
+	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+	if (hTblPtr == (Tcl_HashTable *) NULL) {
 	    return TCL_ERROR;
 	}
 	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
-	if (hPtr == NULL) {
+	if (hPtr == (Tcl_HashEntry *) 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;
 }
+
 
 /*
  *---------------------------------------------------------------------------
@@ -1209,9 +1035,9 @@ DetachChannel(
  *	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.
@@ -1220,26 +1046,26 @@ DetachChannel(
  */
 
 Tcl_Channel
-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. */
+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. */
 {
     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;
@@ -1259,105 +1085,57 @@ Tcl_GetChannel(
 
     hTblPtr = GetChannelTable(interp);
     hPtr = Tcl_FindHashEntry(hTblPtr, name);
-    if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "can not find channel named \"", chanName,
-		"\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
-	return NULL;
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendResult(interp, "can not find channel named \"",
+                chanName, "\"", (char *) 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 = Tcl_GetHashValue(hPtr);
+    chanPtr = (Channel *) 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(
-    const 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(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. */
 {
     Channel *chanPtr;		/* The channel structure newly created. */
-    ChannelState *statePtr;	/* The stack-level independent state info for
-				 * the channel. */
-    const char *name;
-    char *tmp;
+    ChannelState *statePtr;	/* The stack-level independent state info
+				 * for the channel. */
+    CONST char *name;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
@@ -1365,73 +1143,59 @@ Tcl_CreateChannel(
      * 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 *));
+    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 = ckalloc(sizeof(Channel));
-    statePtr = ckalloc(sizeof(ChannelState));
+    chanPtr  = (Channel *) ckalloc((unsigned) sizeof(Channel));
+    statePtr = (ChannelState *) ckalloc((unsigned) 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 != NULL) {
-	unsigned len = strlen(chanName) + 1;
-
-	/*
-         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
-         * later.
-         */
-
-	tmp = ckalloc((len < 7) ? 7 : len);
-	strcpy(tmp, chanName);
+    if (chanName != (char *) NULL) {
+	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));
+        statePtr->channelName = tmp;
+        strcpy(tmp, chanName);
     } else {
-	tmp = ckalloc(7);
-	tmp[0] = '\0';
+        panic("Tcl_CreateChannel: NULL channel name");
     }
-    statePtr->channelName = tmp;
-    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;
@@ -1441,84 +1205,76 @@ Tcl_CreateChannel(
 
     statePtr->unreportedError	= 0;
     statePtr->refCount		= 0;
-    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->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->interestMask	= 0;
-    statePtr->scriptRecordPtr	= NULL;
+    statePtr->scriptRecordPtr	= (EventScriptRecord *) NULL;
     statePtr->bufSize		= CHANNELBUFFER_DEFAULT_SIZE;
     statePtr->timer		= NULL;
     statePtr->csPtrR		= NULL;
     statePtr->csPtrW		= NULL;
 
     statePtr->outputStage	= NULL;
-    if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
-	statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
+    if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+	statePtr->outputStage = (char *)
+	    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	= NULL;
-    chanPtr->upChanPtr		= NULL;
-    chanPtr->inQueueHead	= NULL;
-    chanPtr->inQueueTail	= NULL;
-
-    /*
-     * TIP #219, Tcl Channel Reflection API
-     */
-
-    statePtr->chanMsg		= NULL;
-    statePtr->unreportedMsg	= NULL;
+    chanPtr->downChanPtr	= (Channel *) NULL;
+    chanPtr->upChanPtr		= (Channel *) NULL;
+    chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
+    chanPtr->inQueueTail        = (ChannelBuffer*) 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 = NULL;
-    SpliceChannel((Tcl_Channel) chanPtr);
+    statePtr->nextCSPtr = (ChannelState *) NULL;
+    Tcl_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 ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
-	strcpy(tmp, "stdin");
+#if TCL_INHERIT_STD_CHANNELS
+    if ((tsdPtr->stdinChannel == NULL) &&
+	    (tsdPtr->stdinInitialized == 1)) {
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
-	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
+        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
     } else if ((tsdPtr->stdoutChannel == NULL) &&
 	    (tsdPtr->stdoutInitialized == 1)) {
-	strcpy(tmp, "stdout");
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
-	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
+        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
     } else if ((tsdPtr->stderrChannel == NULL) &&
 	    (tsdPtr->stderrInitialized == 1)) {
-	strcpy(tmp, "stderr");
 	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
-	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
+        Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
     }
+#endif
     return (Tcl_Channel) chanPtr;
 }
 
@@ -1527,52 +1283,53 @@ Tcl_CreateChannel(
  *
  * 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(
-    Tcl_Interp *interp,		/* The interpreter we are working in */
-    const 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 (prevChan) in the list of all channels. If we do
-     * not find it, then it was never registered correctly.
+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.
      *
      * 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)) {
@@ -1582,21 +1339,21 @@ Tcl_StackChannel(
     if (statePtr == NULL) {
 	if (interp) {
 	    Tcl_AppendResult(interp, "couldn't find state for channel \"",
-		    Tcl_GetChannelName(prevChan), "\"", NULL);
+		    Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
 	}
-	return NULL;
+        return (Tcl_Channel) 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 restrict
-     *	W |   |   | + | +  |	the capabilities of the superceded one!
-     *	RW|   | + | + | +  |
+     *	R |   | + |   | +  |	The superceding channel is allowed to
+     *	W |   |   | + | +  |	restrict the capabilities of the
+     *	RW|   | + | + | +  |	superceded one !
      *	--+---+---+---+----+
      */
 
@@ -1604,76 +1361,80 @@ Tcl_StackChannel(
 	if (interp) {
 	    Tcl_AppendResult(interp,
 		    "reading and writing both disallowed for channel \"",
-		    Tcl_GetChannelName(prevChan), "\"", NULL);
+		    Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
 	}
-	return NULL;
+        return (Tcl_Channel) 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) {
-	CopyState *csPtrR = statePtr->csPtrR;
-	CopyState *csPtrW = statePtr->csPtrW;
+        CopyState *csPtrR;
+        CopyState *csPtrW;
+
+        csPtrR           = statePtr->csPtrR;
+	statePtr->csPtrR = (CopyState*) NULL;
 
-	statePtr->csPtrR = NULL;
-	statePtr->csPtrW = NULL;
+        csPtrW           = statePtr->csPtrW;
+	statePtr->csPtrW = (CopyState*) 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), "\"", NULL);
+			Tcl_GetChannelName(prevChan), "\"", (char *) NULL);
 	    }
-	    return NULL;
+	    return (Tcl_Channel) 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 != NULL)) {
-	/*
-	 * Remark: It is possible that the channel buffers contain data from
-	 * some earlier push-backs.
-	 */
+    if (((mask & TCL_READABLE) != 0) &&
+	(statePtr->inQueueHead != (ChannelBuffer*) 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 == NULL) {
-	    prevChanPtr->inQueueTail = statePtr->inQueueTail;
-	}
+      if (prevChanPtr->inQueueTail == (ChannelBuffer*) NULL) {
+	prevChanPtr->inQueueTail = statePtr->inQueueTail;
+      }
 
-	statePtr->inQueueHead = NULL;
-	statePtr->inQueueTail = NULL;
+      statePtr->inQueueHead          = (ChannelBuffer*) NULL;
+      statePtr->inQueueTail          = (ChannelBuffer*) NULL;
     }
 
-    chanPtr = ckalloc(sizeof(Channel));
+    chanPtr = (Channel *) ckalloc((unsigned) 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:
      */
@@ -1682,9 +1443,9 @@ Tcl_StackChannel(
     chanPtr->instanceData	= instanceData;
     chanPtr->typePtr		= typePtr;
     chanPtr->downChanPtr	= prevChanPtr;
-    chanPtr->upChanPtr		= NULL;
-    chanPtr->inQueueHead	= NULL;
-    chanPtr->inQueueTail	= NULL;
+    chanPtr->upChanPtr		= (Channel *) NULL;
+    chanPtr->inQueueHead        = (ChannelBuffer*) NULL;
+    chanPtr->inQueueTail        = (ChannelBuffer*) NULL;
 
     /*
      * Place new block at the head of a possibly existing list of previously
@@ -1694,19 +1455,6 @@ Tcl_StackChannel(
     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.
-     */
-
-    ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
-
     return (Tcl_Channel) chanPtr;
 }
 
@@ -1715,25 +1463,25 @@ Tcl_StackChannel(
  *
  * 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. May leave a message in interp result as well.
+ *	If TCL_ERROR is returned, the posix error code will be set
+ *	with Tcl_SetErrno.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_UnstackChannel(
-    Tcl_Interp *interp,		/* The interpreter we are working in */
-    Tcl_Channel chan)		/* The channel to unstack */
+Tcl_UnstackChannel (interp, chan)
+    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;
 
@@ -1743,47 +1491,40 @@ Tcl_UnstackChannel(
 
     chanPtr = statePtr->topChanPtr;
 
-    if (chanPtr->downChanPtr != NULL) {
-	/*
+    if (chanPtr->downChanPtr != (Channel *) 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.
+	 * 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.
 	 */
 
-	if (GotFlag(statePtr, TCL_WRITABLE)) {
-	    CopyState *csPtrR = statePtr->csPtrR;
-	    CopyState *csPtrW = statePtr->csPtrW;
+	if (statePtr->flags & TCL_WRITABLE) {
+	    CopyState *csPtrR;
+	    CopyState *csPtrW;
+
+	    csPtrR           = statePtr->csPtrR;
+	    statePtr->csPtrR = (CopyState*) NULL;
 
-	    statePtr->csPtrR = NULL;
-	    statePtr->csPtrW = NULL;
+	    csPtrW           = statePtr->csPtrW;
+	    statePtr->csPtrW = (CopyState*) NULL;
 
 	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
-		statePtr->csPtrR = csPtrR;
+	        statePtr->csPtrR  = csPtrR;
 		statePtr->csPtrW = csPtrW;
-
-		/*
-		 * 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) {
+		if (interp) {
 		    Tcl_AppendResult(interp, "could not flush channel \"",
 			    Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
-			    NULL);
+			    (char *) NULL);
 		}
 		return TCL_ERROR;
 	    }
@@ -1793,106 +1534,78 @@ Tcl_UnstackChannel(
 	}
 
 	/*
-	 * 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 (GotFlag(statePtr, TCL_READABLE) &&
-		((statePtr->inQueueHead != NULL) ||
-		(chanPtr->inQueueHead != NULL))) {
-	    if ((statePtr->inQueueHead != NULL) &&
-		    (chanPtr->inQueueHead != NULL)) {
-		statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
+	if (((statePtr->flags & TCL_READABLE)  != 0) &&
+	    ((statePtr->inQueueHead != (ChannelBuffer*) NULL) ||
+	     (chanPtr->inQueueHead  != (ChannelBuffer*) NULL))) {
+
+	    if ((statePtr->inQueueHead != (ChannelBuffer*) NULL) &&
+		(chanPtr->inQueueHead  != (ChannelBuffer*) NULL)) {
+	        statePtr->inQueueTail->nextPtr = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
-		statePtr->inQueueHead = statePtr->inQueueTail;
-	    } else if (chanPtr->inQueueHead != NULL) {
-		statePtr->inQueueHead = chanPtr->inQueueHead;
+	        statePtr->inQueueHead = statePtr->inQueueTail;
+
+	    } else if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
+	        statePtr->inQueueHead = chanPtr->inQueueHead;
 		statePtr->inQueueTail = chanPtr->inQueueTail;
 	    }
 
-	    chanPtr->inQueueHead = NULL;
-	    chanPtr->inQueueTail = NULL;
+	    chanPtr->inQueueHead          = (ChannelBuffer*) NULL;
+	    chanPtr->inQueueTail          = (ChannelBuffer*) NULL;
 
-	    DiscardInputQueued(statePtr, 0);
+	    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.
-	 */
-
-	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
-
-	statePtr->topChanPtr = downChanPtr;
-	downChanPtr->upChanPtr = NULL;
+	statePtr->topChanPtr	= downChanPtr;
+	downChanPtr->upChanPtr	= (Channel *) NULL;
 
 	/*
 	 * Leave this link intact for closeproc
-	 *  chanPtr->downChanPtr = NULL;
+	 *  chanPtr->downChanPtr	= (Channel *) NULL;
 	 */
 
 	/*
 	 * Close and free the channel driver state.
 	 */
 
-	result = ChanClose(chanPtr, interp);
-	chanPtr->typePtr = NULL;
+	if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+	    result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
+		    interp);
+	} else {
+	    result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
+		    interp, 0);
+	}
 
+	chanPtr->typePtr	= NULL;
 	/*
 	 * AK: Tcl_NotifyChannel may hold a reference to this block of memory
 	 */
-
-	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
+	Tcl_EventuallyFree((ClientData) 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) {
-		/*
-		 * TIP #219, Tcl Channel Reflection API.
-		 * "TclChanCaughtErrorBypass" is not required here, it was
-		 * done already by "Tcl_Close".
-		 */
-
-		return TCL_ERROR;
-	    }
+        if (statePtr->refCount <= 0) {
+            if (Tcl_Close(interp, chan) != TCL_OK) {
+                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;
@@ -1906,9 +1619,9 @@ Tcl_UnstackChannel(
  *	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.
@@ -1917,11 +1630,10 @@ Tcl_UnstackChannel(
  */
 
 Tcl_Channel
-Tcl_GetStackedChannel(
-    Tcl_Channel chan)
+Tcl_GetStackedChannel(chan)
+    Tcl_Channel chan;
 {
-    Channel *chanPtr = (Channel *) chan;
-				/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
 
     return (Tcl_Channel) chanPtr->downChanPtr;
 }
@@ -1934,9 +1646,9 @@ Tcl_GetStackedChannel(
  *	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.
@@ -1945,11 +1657,10 @@ Tcl_GetStackedChannel(
  */
 
 Tcl_Channel
-Tcl_GetTopChannel(
-    Tcl_Channel chan)
+Tcl_GetTopChannel(chan)
+    Tcl_Channel chan;
 {
-    Channel *chanPtr = (Channel *) chan;
-				/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
 
     return (Tcl_Channel) chanPtr->state->topChanPtr;
 }
@@ -1971,11 +1682,10 @@ Tcl_GetTopChannel(
  */
 
 ClientData
-Tcl_GetChannelInstanceData(
-    Tcl_Channel chan)		/* Channel for which to return client data. */
+Tcl_GetChannelInstanceData(chan)
+    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;
 }
@@ -1985,7 +1695,8 @@ Tcl_GetChannelInstanceData(
  *
  * 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.
@@ -1997,12 +1708,10 @@ Tcl_GetChannelInstanceData(
  */
 
 Tcl_ThreadId
-Tcl_GetChannelThread(
-    Tcl_Channel chan)		/* The channel to return the managing thread
-				 * for. */
+Tcl_GetChannelThread(chan)
+    Tcl_Channel chan;		/* The channel to return managing thread for. */
 {
-    Channel *chanPtr = (Channel *) chan;
-				/* The actual channel. */
+    Channel *chanPtr = (Channel *) chan;	/* The actual channel. */
 
     return chanPtr->state->managingThread;
 }
@@ -2023,12 +1732,11 @@ Tcl_GetChannelThread(
  *----------------------------------------------------------------------
  */
 
-const Tcl_ChannelType *
-Tcl_GetChannelType(
-    Tcl_Channel chan)		/* The channel to return type for. */
+Tcl_ChannelType *
+Tcl_GetChannelType(chan)
+    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;
 }
@@ -2038,8 +1746,8 @@ Tcl_GetChannelType(
  *
  * 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.
@@ -2051,12 +1759,12 @@ Tcl_GetChannelType(
  */
 
 int
-Tcl_GetChannelMode(
-    Tcl_Channel chan)		/* The channel for which the mode is being
-				 * computed. */
+Tcl_GetChannelMode(chan)
+    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));
 }
@@ -2069,8 +1777,9 @@ Tcl_GetChannelMode(
  *	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.
@@ -2078,13 +1787,13 @@ Tcl_GetChannelMode(
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_GetChannelName(
-    Tcl_Channel chan)		/* The channel for which to return the name. */
+CONST char *
+Tcl_GetChannelName(chan)
+    Tcl_Channel chan;		/* The channel for which to return the name. */
 {
-    ChannelState *statePtr = ((Channel *) chan)->state;
-				/* State of actual channel. */
+    ChannelState *statePtr;	/* State of actual channel. */
 
+    statePtr = ((Channel *) chan)->state;
     return statePtr->channelName;
 }
 
@@ -2106,24 +1815,18 @@ Tcl_GetChannelName(
  */
 
 int
-Tcl_GetChannelHandle(
-    Tcl_Channel chan,		/* The channel to get file from. */
-    int direction,		/* TCL_WRITABLE or TCL_READABLE. */
-    ClientData *handlePtr)	/* Where to store handle */
+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 */
 {
     Channel *chanPtr;		/* The actual channel. */
     ClientData handle;
     int result;
 
     chanPtr = ((Channel *) chan)->state->bottomChanPtr;
-    if (!chanPtr->typePtr->getHandleProc) {
-        Tcl_SetChannelError(chan, Tcl_ObjPrintf(
-                "channel \"%s\" does not support OS handles",
-                Tcl_GetChannelName(chan)));
-	return TCL_ERROR;
-    }
-    result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction,
-	    &handle);
+    result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
+	    direction, &handle);
     if (handlePtr) {
 	*handlePtr = handle;
     }
@@ -2135,15 +1838,16 @@ Tcl_GetChannelHandle(
  *
  * 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.
@@ -2155,18 +1859,18 @@ Tcl_GetChannelHandle(
  */
 
 static ChannelBuffer *
-AllocChannelBuffer(
-    int length)			/* Desired length of channel buffer. */
+AllocChannelBuffer(length)
+    int length;			/* Desired length of channel buffer. */
 {
     ChannelBuffer *bufPtr;
     int n;
 
     n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
-    bufPtr = ckalloc(n);
+    bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
     bufPtr->nextAdded	= BUFFER_PADDING;
     bufPtr->nextRemoved	= BUFFER_PADDING;
     bufPtr->bufLength	= length + BUFFER_PADDING;
-    bufPtr->nextPtr	= NULL;
+    bufPtr->nextPtr	= (ChannelBuffer *) NULL;
     return bufPtr;
 }
 
@@ -2175,10 +1879,11 @@ AllocChannelBuffer(
  *
  * 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.
@@ -2190,70 +1895,70 @@ AllocChannelBuffer(
  */
 
 static void
-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. */
+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. */
 {
     /*
      * Do we have to free the buffer to the OS?
      */
 
     if (mustDiscard) {
-	ckfree(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(bufPtr);
-	return;
+        ckfree((char *) bufPtr);
+        return;
     }
 
     /*
      * Only save buffers for the input queue if the channel is readable.
      */
-
-    if (GotFlag(statePtr, TCL_READABLE)) {
-	if (statePtr->inQueueHead == NULL) {
-	    statePtr->inQueueHead = bufPtr;
-	    statePtr->inQueueTail = bufPtr;
-	    goto keepBuffer;
-	}
-	if (statePtr->saveInBufPtr == NULL) {
-	    statePtr->saveInBufPtr = bufPtr;
-	    goto keepBuffer;
-	}
+    
+    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;
+        }
     }
 
     /*
      * Only save buffers for the output queue if the channel is writable.
      */
 
-    if (GotFlag(statePtr, TCL_WRITABLE)) {
-	if (statePtr->curOutPtr == NULL) {
-	    statePtr->curOutPtr = bufPtr;
-	    goto keepBuffer;
-	}
+    if (statePtr->flags & TCL_WRITABLE) {
+        if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
+            statePtr->curOutPtr = bufPtr;
+            goto keepit;
+        }
     }
 
     /*
      * If we reached this code we return the buffer to the OS.
      */
 
-    ckfree(bufPtr);
+    ckfree((char *) bufPtr);
     return;
 
-  keepBuffer:
+    keepit:
     bufPtr->nextRemoved = BUFFER_PADDING;
     bufPtr->nextAdded = BUFFER_PADDING;
-    bufPtr->nextPtr = NULL;
+    bufPtr->nextPtr = (ChannelBuffer *) NULL;
 }
 
 /*
@@ -2273,18 +1978,18 @@ RecycleBuffer(
  */
 
 static void
-DiscardOutputQueued(
-    ChannelState *statePtr)	/* ChannelState for which to discard output. */
+DiscardOutputQueued(statePtr)
+    ChannelState *statePtr;	/* ChannelState for which to discard output. */
 {
     ChannelBuffer *bufPtr;
-
-    while (statePtr->outQueueHead != NULL) {
-	bufPtr = statePtr->outQueueHead;
-	statePtr->outQueueHead = bufPtr->nextPtr;
-	RecycleBuffer(statePtr, bufPtr, 0);
+    
+    while (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
+        bufPtr = statePtr->outQueueHead;
+        statePtr->outQueueHead = bufPtr->nextPtr;
+        RecycleBuffer(statePtr, bufPtr, 0);
     }
-    statePtr->outQueueHead = NULL;
-    statePtr->outQueueTail = NULL;
+    statePtr->outQueueHead = (ChannelBuffer *) NULL;
+    statePtr->outQueueTail = (ChannelBuffer *) NULL;
 }
 
 /*
@@ -2292,33 +1997,33 @@ DiscardOutputQueued(
  *
  * 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(
-    Tcl_Interp *interp,		/* For error reporting (can be NULL) */
-    ChannelState *statePtr)	/* The channel state to check. */
+CheckForDeadChannel(interp, statePtr)
+    Tcl_Interp *interp;		/* For error reporting (can be NULL) */
+    ChannelState *statePtr;	/* The channel state to check. */
 {
-    if (!GotFlag(statePtr, CHANNEL_DEAD)) {
-	return 0;
-    }
-
-    Tcl_SetErrno(EINVAL);
-    if (interp) {
-	Tcl_AppendResult(interp, "unable to access channel: invalid channel",
-		NULL);
+    if (statePtr->flags & CHANNEL_DEAD) {
+        Tcl_SetErrno(EINVAL);
+	if (interp) {
+	    Tcl_AppendResult(interp,
+		    "unable to access channel: invalid channel",
+		    (char *) NULL);   
+	}
+	return 1;
     }
-    return 1;
+    return 0;
 }
 
 /*
@@ -2326,274 +2031,228 @@ CheckForDeadChannel(
  *
  * FlushChannel --
  *
- *	This function flushes as much of the queued output as is possible now.
- *	If calledFromAsyncFlush is nonzero, it is being called in an event
- *	handler to flush channel output asynchronously.
+ *	This function flushes as much of the queued output as is possible
+ *	now. If calledFromAsyncFlush is nonzero, it is being called in an
+ *	event handler to flush channel output asynchronously.
  *
  * Results:
- *	0 if successful, else the error code that was returned by the channel
- *	type operation. May leave a message in the interp result.
+ *	0 if successful, else the error code that was returned by the
+ *	channel type operation.
  *
  * 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(
-    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(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. */
 {
     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.
      */
 
-    Tcl_Preserve(chanPtr);
     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))
-		|| (GotFlag(statePtr, 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 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 we are not being called from an async flush and an async flush
-	 * is active, we just return without producing any output.
-	 */
+        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 (!calledFromAsyncFlush && GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
-	    errorCode = 0;
-	    goto done;
-	}
+        /*
+         * 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 output queue is still empty, break out of the while loop.
-	 */
+        if ((!calledFromAsyncFlush) &&
+                (statePtr->flags & BG_FLUSH_SCHEDULED)) {
+            return 0;
+        }
 
-	if (bufPtr == NULL) {
-	    break;		/* Out of the "while (1)". */
-	}
+        /*
+         * If the output queue is still empty, break out of the while loop.
+         */
 
-	/*
-	 * Produce the output on the channel.
-	 */
+        if (bufPtr == (ChannelBuffer *) NULL) {
+            break;	/* Out of the "while (1)". */
+        }
 
-	toWrite = BytesLeft(bufPtr);
+        /*
+         * Produce the output on the channel.
+         */
+
+        toWrite = bufPtr->nextAdded - bufPtr->nextRemoved;
 	if (toWrite == 0) {
-            written = 0;
+	    written = 0;
 	} else {
-	    written = ChanWrite(chanPtr, RemovePoint(bufPtr), toWrite,
-		    &errorCode);
+	    written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
+                bufPtr->buf + bufPtr->nextRemoved, 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 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 (errorCode == EINTR) {
-		errorCode = 0;
-		continue;
-	    }
+        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 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 ((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 (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
-		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
+		if (!(statePtr->flags & BG_FLUSH_SCHEDULED)) {
+		    statePtr->flags |= BG_FLUSH_SCHEDULED;
 		    UpdateInterest(chanPtr);
 		}
 		errorCode = 0;
 		break;
-	    }
-
-	    /*
-	     * 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.
-		 */
+            /*
+             * Decide whether to report the error upwards or defer it.
+             */
 
-		Tcl_Obj *msg = statePtr->chanMsg;
+            if (calledFromAsyncFlush) {
+                if (statePtr->unreportedError == 0) {
+                    statePtr->unreportedError = errorCode;
+                }
+            } else {
+                Tcl_SetErrno(errorCode);
+		if (interp != NULL) {
 
-		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.
+		     * Casting away CONST here is safe because the
+		     * TCL_VOLATILE flag guarantees CONST treatment
+		     * of the Posix error string.
 		     */
 
-		    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)) {
-		    Tcl_SetObjResult(interp,
-			    Tcl_NewStringObj(Tcl_PosixError(interp), -1));
+		    Tcl_SetResult(interp,
+			    (char *) Tcl_PosixError(interp), TCL_VOLATILE);
 		}
+            }
 
-		/*
-		 * An unreportable bypassed message is kept, for the caller of
-		 * Tcl_Seek, Tcl_Write, etc.
-		 */
-	    }
-
-	    /*
-	     * When we get an error we throw away all the output currently
-	     * queued.
-	     */
+            /*
+             * When we get an error we throw away all the output
+             * currently queued.
+             */
 
-	    DiscardOutputQueued(statePtr);
-	    continue;
-	} else {
+            DiscardOutputQueued(statePtr);
+            continue;
+        } else {
 	    wroteSome = 1;
 	}
 
-	if (!IsBufferEmpty(bufPtr)) {
-	    bufPtr->nextRemoved += written;
-	}
+        bufPtr->nextRemoved += written;
 
-	/*
-	 * If this buffer is now empty, recycle it.
-	 */
+        /*
+         * If this buffer is now empty, recycle it.
+         */
 
-	if (IsBufferEmpty(bufPtr)) {
-	    statePtr->outQueueHead = bufPtr->nextPtr;
-	    if (statePtr->outQueueHead == NULL) {
-		statePtr->outQueueTail = NULL;
-	    }
-	    RecycleBuffer(statePtr, bufPtr, 0);
-	}
+        if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+            statePtr->outQueueHead = bufPtr->nextPtr;
+            if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+                statePtr->outQueueTail = (ChannelBuffer *) 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 (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+    if (statePtr->flags & BG_FLUSH_SCHEDULED) {
 	if (wroteSome) {
-	    goto done;
-	} else if (statePtr->outQueueHead == NULL) {
-	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
-	    ChanWatch(chanPtr, statePtr->interestMask);
+	    return errorCode;
+	} else if (statePtr->outQueueHead == (ChannelBuffer *) NULL) {
+	    statePtr->flags &= (~(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 (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
-	    (statePtr->outQueueHead == NULL) &&
-	    ((statePtr->curOutPtr == NULL) ||
-	    IsBufferEmpty(statePtr->curOutPtr))) {
-	errorCode = CloseChannel(interp, chanPtr, errorCode);
-	goto done;
+    if ((statePtr->flags & CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
+            (statePtr->outQueueHead == (ChannelBuffer *) NULL) &&
+            ((statePtr->curOutPtr == (ChannelBuffer *) NULL) ||
+                    (statePtr->curOutPtr->nextAdded ==
+                            statePtr->curOutPtr->nextRemoved))) {
+	return CloseChannel(interp, chanPtr, errorCode);
     }
-
-    /*
-     * If the write-side of the channel is flagged as closed, delete it when
-     * the output queue is empty and there is no output in the current output
-     * buffer.
-     */
-
-    if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) &&
-	    (statePtr->outQueueHead == NULL) &&
-	    ((statePtr->curOutPtr == NULL) ||
-	    IsBufferEmpty(statePtr->curOutPtr))) {
-	errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE);
-	goto done;
-    }
-
-  done:
-    Tcl_Release(chanPtr);
     return errorCode;
 }
 
@@ -2606,33 +2265,34 @@ FlushChannel(
  *
  *	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:
- *	Error code from an unreported error or the driver close operation.
+ *	1 if the channel was stacked, 0 otherwise.
  *
  * 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(
-    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(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. */
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (chanPtr == NULL) {
-	return result;
+        return result;
     }
     statePtr = chanPtr->state;
 
@@ -2646,103 +2306,81 @@ CloseChannel(
      * Discard a leftover buffer in the current output buffer field.
      */
 
-    if (statePtr->curOutPtr != NULL) {
-	ckfree(statePtr->curOutPtr);
-	statePtr->curOutPtr = NULL;
+    if (statePtr->curOutPtr != (ChannelBuffer *) NULL) {
+        ckfree((char *) statePtr->curOutPtr);
+        statePtr->curOutPtr = (ChannelBuffer *) 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 != NULL) {
-	Tcl_Panic("TclFlush, closed channel: queued output left");
+    if (statePtr->outQueueHead != (ChannelBuffer *) NULL) {
+        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) && GotFlag(statePtr, TCL_WRITABLE)) {
-	int dummy;
-	char c = (char) statePtr->outEofChar;
-
-	(void) ChanWrite(chanPtr, &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->outEofChar != 0) && (statePtr->flags & TCL_WRITABLE)) {
+        int dummy;
+        char c;
 
-    if (statePtr->chanMsg != NULL) {
-	if (interp != NULL) {
-	    Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
-	}
-	TclDecrRefCount(statePtr->chanMsg);
-	statePtr->chanMsg = NULL;
+        c = (char) statePtr->outEofChar;
+        (chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
     }
 
     /*
      * Remove this channel from of the list of all channels.
      */
-
-    CutChannel((Tcl_Channel) chanPtr);
+    Tcl_CutChannel((Tcl_Channel) chanPtr);
 
     /*
      * Close and free the channel driver state.
-     * This may leave a TIP #219 error message in the interp.
      */
 
-    result = ChanClose(chanPtr, interp);
+    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+	result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
+    } else {
+	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 != NULL) {
-	    ckfree(statePtr->channelName);
+	if (statePtr->channelName != (char *) NULL) {
+	    ckfree((char *) statePtr->channelName);
 	    statePtr->channelName = NULL;
 	}
 
 	Tcl_FreeEncoding(statePtr->encoding);
 	if (statePtr->outputStage != NULL) {
-	    ckfree(statePtr->outputStage);
-	    statePtr->outputStage = NULL;
+	    ckfree((char *) statePtr->outputStage);
+	    statePtr->outputStage = (char *) 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;
-
-	/*
-	 * 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);
-	}
+        errorCode = statePtr->unreportedError;
     }
     if (errorCode == 0) {
-	errorCode = result;
-	if (errorCode != 0) {
-	    Tcl_SetErrno(errorCode);
-	}
+        errorCode = result;
+        if (errorCode != 0) {
+            Tcl_SetErrno(errorCode);
+        }
     }
 
     /*
@@ -2755,31 +2393,31 @@ CloseChannel(
      * Mark the channel as deleted by clearing the type structure.
      */
 
-    if (chanPtr->downChanPtr != NULL) {
+    if (chanPtr->downChanPtr != (Channel *) NULL) {
 	Channel *downChanPtr = chanPtr->downChanPtr;
 
-	statePtr->nextCSPtr = tsdPtr->firstCSPtr;
-	tsdPtr->firstCSPtr = statePtr;
+	statePtr->nextCSPtr	= tsdPtr->firstCSPtr;
+	tsdPtr->firstCSPtr	= statePtr;
 
-	statePtr->topChanPtr = downChanPtr;
-	downChanPtr->upChanPtr = NULL;
-	chanPtr->typePtr = NULL;
+	statePtr->topChanPtr	= downChanPtr;
+	downChanPtr->upChanPtr	= (Channel *) NULL;
+	chanPtr->typePtr	= NULL;
 
-	Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
+	Tcl_EventuallyFree((ClientData) 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 references.
+     * 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
      */
-
     chanPtr->typePtr = NULL;
 
-    Tcl_EventuallyFree(statePtr, TCL_DYNAMIC);
-    Tcl_EventuallyFree(chanPtr, TCL_DYNAMIC);
+    Tcl_EventuallyFree((ClientData) statePtr, TCL_DYNAMIC);
+    Tcl_EventuallyFree((ClientData) chanPtr, TCL_DYNAMIC);
 
     return errorCode;
 }
@@ -2788,10 +2426,10 @@ CloseChannel(
  *----------------------------------------------------------------------
  *
  * 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.
@@ -2800,96 +2438,56 @@ CloseChannel(
  *	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.
  *
  *----------------------------------------------------------------------
  */
 
-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. */
-
-    /*
-     * 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
-     */
-
-    ChanThreadAction((Channel *) 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_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. */
+    ChannelState *statePtr = ((Channel *) chan)->state;
+					/* 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 == NULL) {
-	    Tcl_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 == (ChannelState *) NULL) {
+            panic("FlushChannel: damaged channel list");
+        }
+        prevCSPtr->nextCSPtr = statePtr->nextCSPtr;
     }
 
-    statePtr->nextCSPtr = NULL;
+    statePtr->nextCSPtr = (ChannelState *) NULL;
 
-    /*
-     * TIP #218, Channel Thread Actions
-     * For all transformations and the base channel.
-     */
-
-    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
-	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
+    /* TIP #218, Channel Thread Actions */
+    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    if (threadActionProc != NULL) {
+        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+			     TCL_CHANNEL_THREAD_REMOVE);
     }
 }
 
@@ -2897,11 +2495,10 @@ Tcl_CutChannel(
  *----------------------------------------------------------------------
  *
  * 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.
@@ -2911,75 +2508,45 @@ Tcl_CutChannel(
  *
  * 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.
  *
  *----------------------------------------------------------------------
  */
 
-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;
-
-    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
-     */
-
-    ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_INSERT);
-}
-
 void
-Tcl_SpliceChannel(
-    Tcl_Channel chan)		/* The channel being added. Must not be
-				 * referenced in any interpreter. */
+Tcl_SpliceChannel(chan)
+    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;
+    ThreadSpecificData	*tsdPtr = TCL_TSD_INIT(&dataKey);
+    ChannelState	*statePtr = ((Channel *) chan)->state;
+    Tcl_DriverThreadActionProc *threadActionProc;
 
-    if (statePtr->nextCSPtr != NULL) {
-	Tcl_Panic("SpliceChannel: trying to add channel used in different list");
+    if (statePtr->nextCSPtr != (ChannelState *) NULL) {
+        panic("Tcl_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
-     * For all transformations and the base channel.
-     */
-
-    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
-	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
+    /* TIP #218, Channel Thread Actions */
+    threadActionProc = Tcl_ChannelThreadActionProc (Tcl_GetChannelType (chan));
+    if (threadActionProc != NULL) {
+        (*threadActionProc) (Tcl_GetChannelInstanceData(chan),
+			     TCL_CHANNEL_THREAD_INSERT);
     }
 }
 
@@ -2998,30 +2565,29 @@ Tcl_SpliceChannel(
  *
  * 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(
-    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;
+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. */
 
-    if (chan == NULL) {
-	return TCL_OK;
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_OK;
     }
 
     /*
@@ -3038,50 +2604,32 @@ Tcl_Close(
      * 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) {
-	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
+        panic("called Tcl_Close on channel with refCount > 0");
     }
-
-    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
+ 
+    if (statePtr->flags & CHANNEL_INCLOSE) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "Illegal recursive call to close "
-		    "through close-handler of channel", NULL);
+            Tcl_AppendResult(interp,
+	    "Illegal recursive call to close through close-handler of channel",
+	    (char *) NULL);
 	}
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
-    SetFlag(statePtr, CHANNEL_INCLOSE);
+    statePtr->flags |= 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;
-	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;
-	}
+        statePtr->outputEncodingFlags |= TCL_ENCODING_END;
+        WriteChars(chanPtr, "", 0);
     }
 
     Tcl_ClearChannelHandlers(chan);
@@ -3090,419 +2638,46 @@ Tcl_Close(
      * Invoke the registered close callbacks and delete their records.
      */
 
-    while (statePtr->closeCbPtr != NULL) {
-	cbPtr = statePtr->closeCbPtr;
-	statePtr->closeCbPtr = cbPtr->nextPtr;
-	cbPtr->proc(cbPtr->clientData);
-	ckfree(cbPtr);
+    while (statePtr->closeCbPtr != (CloseCallback *) NULL) {
+        cbPtr = statePtr->closeCbPtr;
+        statePtr->closeCbPtr = cbPtr->nextPtr;
+        (cbPtr->proc) (cbPtr->clientData);
+        ckfree((char *) cbPtr);
     }
 
-    ResetFlag(statePtr, CHANNEL_INCLOSE);
+    statePtr->flags &= ~CHANNEL_INCLOSE;
 
     /*
      * Ensure that the last output buffer will be flushed.
      */
-
-    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
-	SetFlag(statePtr, BUFFER_READY);
+    
+    if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+	    (statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+        statePtr->flags |= 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) {
-	result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp,
+	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
 		TCL_CLOSE_READ);
     } else {
 	result = 0;
     }
 
     /*
-     * 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.
-     */
-
-    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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CloseEx --
- *
- *	Closes one side of a channel, read or write.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Closes one direction of the channel.
- *
- * NOTE:
- *	Tcl_CloseEx closes the specified direction of the channel as far as
- *	the user is concerned. The channel keeps existing however. You cannot
- *	calls this function to close the last possible direction of the
- *	channel. Use Tcl_Close for that.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-int
-Tcl_CloseEx(
-    Tcl_Interp *interp,		/* Interpreter for errors. */
-    Tcl_Channel chan,		/* The channel being closed. May still be used
-				 * by some interpreter. */
-    int flags)			/* Flags telling us which side to close. */
-{
-    Channel *chanPtr;		/* The real IO channel. */
-    ChannelState *statePtr;	/* State of real IO channel. */
-
-    if (chan == NULL) {
-	return TCL_OK;
-    }
-
-    /* TODO: assert flags validity ? */
-
-    chanPtr = (Channel *) chan;
-    statePtr = chanPtr->state;
-
-    /*
-     * Does the channel support half-close anyway? Error if not.
-     */
-
-    if (!chanPtr->typePtr->close2Proc) {
-	Tcl_AppendResult(interp, "Half-close of channels not supported by ",
-		chanPtr->typePtr->typeName, "s", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Is the channel unstacked ? If not we fail.
-     */
-
-    if (chanPtr != statePtr->topChanPtr) {
-	Tcl_AppendResult(interp,
-		"Half-close not applicable to stack of transformations",
-		NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Check direction against channel mode. It is an error if we try to close
-     * a direction not supported by the channel (already closed, or never
-     * opened for that direction).
-     */
-
-    if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) {
-	const char *msg;
-
-	if (flags & TCL_CLOSE_READ) {
-	    msg = "read";
-	} else {
-	    msg = "write";
-	}
-	Tcl_AppendResult(interp, "Half-close of ", msg,
-		"-side not possible, side not opened or already closed",
-		NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * A user may try to call half-close from within a channel close
-     * handler. That won't do.
+     * 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.
      */
 
-    if (statePtr->flags & CHANNEL_INCLOSE) {
-	if (interp) {
-	    Tcl_AppendResult(interp, "Illegal recursive call to close "
-		    "through close-handler of channel", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    if (flags & TCL_CLOSE_READ) {
-	/*
-	 * Call the finalization code directly. There are no events to handle,
-	 * there cannot be for the read-side.
-	 */
-
-	return CloseChannelPart(interp, chanPtr, 0, flags);
-    } else if (flags & TCL_CLOSE_WRITE) {
-	if ((statePtr->curOutPtr != NULL) &&
-		IsBufferReady(statePtr->curOutPtr)) {
-	    SetFlag(statePtr, BUFFER_READY);
-	}
-	Tcl_Preserve(statePtr);
-	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
-	    /*
-	     * We don't want to re-enter CloseWrite().
-	     */
-
-	    if (!GotFlag(statePtr, CHANNEL_CLOSEDWRITE)) {
-		if (CloseWrite(interp, chanPtr) != TCL_OK) {
-		    SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
-		    Tcl_Release(statePtr);
-		    return TCL_ERROR;
-		}
-	    }
-	}
-	SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
-	Tcl_Release(statePtr);
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CloseWrite --
- *
- *	Closes the write side a channel.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Closes the write side of the channel.
- *
- * NOTE:
- *	CloseWrite removes the channel as far as the user is concerned.
- *	However, the ooutput data structures may continue to exist for a while
- *	longer if it has a background flush scheduled. The device itself is
- *	eventually closed and the channel structures modified, in
- *	CloseChannelPart, below.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CloseWrite(
-    Tcl_Interp *interp,		/* Interpreter for errors. */
-    Channel *chanPtr)		/* The channel whose write side is being
-                                 * closed. May still be used by some
-                                 * interpreter */
-{
-    /* Notes: clear-channel-handlers - write side only ? or keep around, just
-     * not called. */
-    /* No close cllbacks are run - channel is still open (read side) */
-
-    ChannelState *statePtr = chanPtr->state;
-                                /* State of real IO channel. */
-    int flushcode;
-    int result = 0;
-
-    /*
-     * Ensure that the last output buffer will be flushed.
-     */
-
-    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
-	SetFlag(statePtr, BUFFER_READY);
-    }
-
-    /*
-     * 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_CLOSEDWRITE);
-
-    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_CLOSEDWRITE in the flags
-     * FlushChannel() has called CloseChannelPart(). While we can still access
-     * "chan" (no structures were freed), the only place which may still
-     * contain a message is the interpreter itself, and "CloseChannelPart" made
-     * sure to lift any channel message it generated into it. Hence the NULL
-     * argument in the call below.
-     */
-
-    if (TclChanCaughtErrorBypass(interp, NULL)) {
-	result = EINVAL;
-    }
-
-    if ((flushcode != 0) || (result != 0)) {
-	return TCL_ERROR;
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * CloseChannelPart --
- *
- *	Utility procedure to close a channel partially and free associated
- *	resources. If the channel was stacked it will never be run (The higher
- *	level forbid this). If the channel was not stacked, then we will free
- *	all the bits of the chosen side (read, or write) for the TOP channel.
- *
- * Results:
- *	Error code from an unreported error or the driver close2 operation.
- *
- * Side effects:
- *	May free memory, may change the value of errno.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-CloseChannelPart(
-    Tcl_Interp *interp,		/* Interpreter for errors. */
-    Channel *chanPtr,		/* The channel being closed. May still be used
-				 * by some interpreter. */
-    int errorCode,		/* Status of operation so far. */
-    int flags)			/* Flags telling us which side to close. */
-{
-    ChannelState *statePtr;	/* State of real IO channel. */
-    int result;			/* Of calling the close2proc. */
-
-    statePtr = chanPtr->state;
-
-    if (flags & TCL_CLOSE_READ) {
-	/*
-	 * No more input can be consumed so discard any leftover input.
-	 */
-
-	DiscardInputQueued(statePtr, 1);
-    } else if (flags & TCL_CLOSE_WRITE) {
-	/*
-	 * The caller guarantees that there are no more buffers queued for
-	 * output.
-	 */
-
-	if (statePtr->outQueueHead != NULL) {
-	    Tcl_Panic("ClosechanHalf, closed write-side of channel: "
-		    "queued output left");
-	}
-
-	/*
-	 * If the EOF character is set in the channel, append that to the
-	 * output device.
-	 */
-
-	if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
-	    int dummy;
-	    char c = (char) statePtr->outEofChar;
-
-	    (void) ChanWrite(chanPtr, &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;
-	}
-    }
-
-    /*
-     * Finally do what is asked of us. Close and free the channel driver state
-     * for the chosen side of the channel. This may leave a TIP #219 error
-     * message in the interp.
-     */
-
-    result = ChanCloseHalf(chanPtr, interp, flags);
-
-    /*
-     * 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;
-
-	/*
-	 * 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);
-	}
-    }
-
-    /*
-     * TIP #219.
-     * Capture error messages put by the driver into the bypass area and put
-     * them into the regular interpreter result. See also the bottom of
-     * CloseWrite().
-     */
-
-    if (TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
-	result = EINVAL;
-    }
-
-    if (result != 0) {
-	return TCL_ERROR;
+    statePtr->flags |= CHANNEL_CLOSED;
+    if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
+        return TCL_ERROR;
     }
-
-    /*
-     * Remove the closed side from the channel mode/flags.
-     */
-
-    ResetFlag(statePtr, flags & (TCL_READABLE | TCL_WRITABLE));
     return TCL_OK;
 }
 
@@ -3525,8 +2700,8 @@ CloseChannelPart(
  */
 
 void
-Tcl_ClearChannelHandlers(
-    Tcl_Channel channel)
+Tcl_ClearChannelHandlers (channel)
+    Tcl_Channel channel;
 {
     ChannelHandler *chPtr, *chNext;	/* Iterate over channel handlers. */
     EventScriptRecord *ePtr, *eNextPtr;	/* Iterate over eventscript records. */
@@ -3539,9 +2714,9 @@ Tcl_ClearChannelHandlers(
      * 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.
@@ -3550,27 +2725,31 @@ Tcl_ClearChannelHandlers(
     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 != NULL;
-	    nhPtr = nhPtr->nestedHandlerPtr) {
-	if (nhPtr->nextHandlerPtr &&
+    for (nhPtr = tsdPtr->nestedHandlerPtr;
+	 nhPtr != (NextChannelHandler *) 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 != NULL; chPtr = chNext) {
-	chNext = chPtr->nextPtr;
-	ckfree(chPtr);
+    for (chPtr = statePtr->chPtr;
+	 chPtr != (ChannelHandler *) NULL;
+	 chPtr = chNext) {
+        chNext = chPtr->nextPtr;
+        ckfree((char *) chPtr);
     }
-    statePtr->chPtr = NULL;
+    statePtr->chPtr = (ChannelHandler *) NULL;
 
     /*
      * Cancel any pending copy operation.
@@ -3592,12 +2771,14 @@ Tcl_ClearChannelHandlers(
      * Remove any EventScript records for this channel.
      */
 
-    for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
-	eNextPtr = ePtr->nextPtr;
-	TclDecrRefCount(ePtr->scriptPtr);
-	ckfree(ePtr);
+    for (ePtr = statePtr->scriptRecordPtr;
+	 ePtr != (EventScriptRecord *) NULL;
+	 ePtr = eNextPtr) {
+        eNextPtr = ePtr->nextPtr;
+	Tcl_DecrRefCount(ePtr->scriptPtr);
+        ckfree((char *) ePtr);
     }
-    statePtr->scriptRecordPtr = NULL;
+    statePtr->scriptRecordPtr = (EventScriptRecord *) NULL;
 }
 
 /*
@@ -3605,11 +2786,11 @@ Tcl_ClearChannelHandlers(
  *
  * 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.
  *
@@ -3625,28 +2806,27 @@ Tcl_ClearChannelHandlers(
  */
 
 int
-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(). */
+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(). */
 {
     /*
      * 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);
 }
@@ -3656,11 +2836,11 @@ Tcl_Write(
  *
  * 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.
  *
@@ -3676,15 +2856,14 @@ Tcl_Write(
  */
 
 int
-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(). */
+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(). */
 {
     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) {
@@ -3692,7 +2871,7 @@ Tcl_WriteRaw(
     }
 
     if (srcLen < 0) {
-	srcLen = strlen(src);
+        srcLen = strlen(src);
     }
 
     /*
@@ -3700,7 +2879,9 @@ Tcl_WriteRaw(
      * The code was stolen from 'FlushChannel'.
      */
 
-    written = ChanWrite(chanPtr, src, srcLen, &errorCode);
+    written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
+	    src, srcLen, &errorCode);
+
     if (written < 0) {
 	Tcl_SetErrno(errorCode);
     }
@@ -3714,11 +2895,11 @@ Tcl_WriteRaw(
  * 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,
@@ -3732,14 +2913,13 @@ Tcl_WriteRaw(
  */
 
 int
-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
+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 
 				 * strlen(). */
 {
-    ChannelState *statePtr;	/* State info for channel */
+    ChannelState *statePtr;	/* state info for channel */
 
     statePtr = ((Channel *) chan)->state;
 
@@ -3747,7 +2927,7 @@ Tcl_WriteChars(
 	return -1;
     }
 
-    return DoWriteChars((Channel *) chan, src, len);
+    return DoWriteChars ((Channel*) chan, src, len);
 }
 
 /*
@@ -3756,11 +2936,11 @@ Tcl_WriteChars(
  * 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,
@@ -3774,44 +2954,36 @@ Tcl_WriteChars(
  */
 
 static int
-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
+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 
 				 * 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.
-	 * Special case for 1-byte (used by eg [puts] for the \n) could
-	 * be extended to more efficient translation of the src string.
+	 * Inefficient way to convert UTF-8 to byte-array, but the  
+	 * code parallels the way it is done for objects.
 	 */
 
+	Tcl_Obj *objPtr;
 	int result;
 
-	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);
-	}
+	objPtr = Tcl_NewStringObj(src, len);
+	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
+	result = WriteBytes(chanPtr, src, len);
+	Tcl_DecrRefCount(objPtr);
 	return result;
     }
     return WriteChars(chanPtr, src, len);
@@ -3822,17 +2994,17 @@ DoWriteChars(
  *
  * 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:
@@ -3843,21 +3015,20 @@ DoWriteChars(
  */
 
 int
-Tcl_WriteObj(
-    Tcl_Channel chan,		/* The channel to buffer output for. */
-    Tcl_Obj *objPtr)		/* The object to write. */
+Tcl_WriteObj(chan, objPtr)
+    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 */
-    const char *src;
+    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;
@@ -3866,52 +3037,20 @@ Tcl_WriteObj(
 	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
 	return WriteBytes(chanPtr, src, srcLen);
     } else {
-	src = TclGetStringFromObj(objPtr, &srcLen);
+	src = Tcl_GetStringFromObj(objPtr, &srcLen);
 	return WriteChars(chanPtr, src, srcLen);
     }
 }
 
-static void
-WillWrite(
-    Channel *chanPtr)
-{
-    int inputBuffered;
-
-    if ((chanPtr->typePtr->seekProc != NULL) &&
-            ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
-        int ignore;
-
-        DiscardInputQueued(chanPtr->state, 0);
-        ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
-    }
-}
-
-static int
-WillRead(
-    Channel *chanPtr)
-{
-    if ((chanPtr->typePtr->seekProc != NULL)
-            && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
-        if ((chanPtr->state->curOutPtr != NULL)
-                && IsBufferReady(chanPtr->state->curOutPtr)) {
-            SetFlag(chanPtr->state, BUFFER_READY);
-        }
-        if (FlushChannel(NULL, chanPtr, 0) != 0) {
-            return -1;
-        }
-    }
-    return 0;
-}
-
 /*
  *----------------------------------------------------------------------
  *
  * 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,
@@ -3925,40 +3064,33 @@ WillRead(
  */
 
 static int
-WriteBytes(
-    Channel *chanPtr,		/* The channel to buffer output for. */
-    const char *src,		/* Bytes to write. */
-    int srcLen)			/* Number of bytes to write. */
+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. */
 {
-    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, translate;
-
-    if (srcLen) {
-        WillWrite(chanPtr);
-    }
-
+    int dstMax, sawLF, savedLF, total, dstLen, toWrite;
+    
     total = 0;
     sawLF = 0;
     savedLF = 0;
-    translate = GotFlag(statePtr, 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 = InsertPoint(bufPtr);
-	dstMax = SpaceLeft(bufPtr);
+	dst = bufPtr->buf + bufPtr->nextAdded;
+	dstMax = bufPtr->bufLength - bufPtr->nextAdded;
 	dstLen = dstMax;
 
 	toWrite = dstLen;
@@ -3966,32 +3098,25 @@ WriteBytes(
 	    toWrite = srcLen;
 	}
 
-	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.
-		 */
+	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++;
-	    }
-	    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;
+	    *dst++ = '\n';
+	    dstLen--;
+	    sawLF++;
 	}
+	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;
@@ -4009,10 +3134,11 @@ WriteBytes(
  *
  * 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,
@@ -4026,25 +3152,20 @@ WriteBytes(
  */
 
 static int
-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. */
+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. */
 {
-    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, translate;
+    int consumedSomething;
     Tcl_Encoding encoding;
     char safe[BUFFER_PADDING];
-
-    if (srcLen) {
-        WillWrite(chanPtr);
-    }
-
+    
     total = 0;
     sawLF = 0;
     savedLF = 0;
@@ -4057,9 +3178,6 @@ WriteChars(
 
     endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
 
-    translate = GotFlag(statePtr, CHANNEL_LINEBUFFERED)
-	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF);
-
     /*
      * Loop over all UTF-8 characters in src, storing them in staging buffer
      * with proper EOL translation.
@@ -4067,7 +3185,7 @@ WriteChars(
 
     consumedSomething = 1;
     while (consumedSomething && (srcLen + savedLF + endEncoding > 0)) {
-	consumedSomething = 0;
+        consumedSomething = 0;
 	stage = statePtr->outputStage;
 	stageMax = statePtr->bufSize;
 	stageLen = stageMax;
@@ -4077,35 +3195,27 @@ WriteChars(
 	    toWrite = srcLen;
 	}
 
-	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++;
-	    }
+	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);
 
-	    stage -= savedLF;
-	    stageLen += savedLF;
-	    savedLF = 0;
+	stage -= savedLF;
+	stageLen += savedLF;
+	savedLF = 0;
 
-	    if (stageLen > stageMax) {
-		savedLF = 1;
-		stageLen = stageMax;
-	    }
-	} else {
-	    memcpy(stage, src, toWrite);
-	    stageLen = toWrite;
+	if (stageLen > stageMax) {
+	    savedLF = 1;
+	    stageLen = stageMax;
 	}
 	src += toWrite;
 	srcLen -= toWrite;
@@ -4121,16 +3231,17 @@ WriteChars(
 		bufPtr = AllocChannelBuffer(statePtr->bufSize);
 		statePtr->curOutPtr = bufPtr;
 	    }
-	    dst = InsertPoint(bufPtr);
-	    dstLen = SpaceLeft(bufPtr);
+	    dst = bufPtr->buf + bufPtr->nextAdded;
+	    dstLen = bufPtr->bufLength - bufPtr->nextAdded;
 
 	    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(dst, safe, (size_t) saved);
+		 
+		memcpy((VOID *) dst, (VOID *) safe, (size_t) saved);
 		bufPtr->nextAdded += saved;
 		dst += saved;
 		dstLen -= saved;
@@ -4142,8 +3253,7 @@ WriteChars(
 		    &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
@@ -4159,15 +3269,13 @@ WriteChars(
 	     */
 
 	    statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
-
 	    /*
 	     * The following code must be executed only when result is not 0.
 	     */
-
-	    if ((result != 0) && (stageRead + dstWrote == 0)) {
+	    if (result && ((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.
 		 */
 
@@ -4178,17 +3286,18 @@ WriteChars(
 		break;
 	    }
 	    bufPtr->nextAdded += dstWrote;
-	    if (IsBufferOverflowing(bufPtr)) {
+	    if (bufPtr->nextAdded > bufPtr->bufLength) {
 		/*
 		 * 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 = -SpaceLeft(bufPtr);
-		memcpy(safe, dst + dstLen, (size_t) saved);
+		saved = bufPtr->nextAdded - bufPtr->bufLength;
+		memcpy((VOID *) safe, (VOID *) (dst + dstLen), (size_t) saved);
 		bufPtr->nextAdded = bufPtr->bufLength;
 	    }
 	    if (CheckFlush(chanPtr, bufPtr, sawLF) != 0) {
@@ -4214,14 +3323,13 @@ WriteChars(
 	}
     }
 
-    /*
-     * 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;
 }
@@ -4231,120 +3339,125 @@ WriteChars(
  *
  * 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(
-    ChannelState *statePtr,	/* Channel being read, for translation and
+TranslateOutputEOL(statePtr, dst, src, dstLenPtr, srcLenPtr)
+    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++;
-	}
-	*dstLenPtr = srcLen;
-	break;
-    case TCL_TRANSLATE_CR:
-	for (dstEnd = dst + srcLen; dst < dstEnd;) {
-	    if (*src == '\n') {
-		*dst++ = '\r';
-		newlineFound = 1;
-		src++;
-	    } else {
+	case TCL_TRANSLATE_LF: {
+	    for (dstEnd = dst + srcLen; dst < dstEnd; ) {
+		if (*src == '\n') {
+		    newlineFound = 1;
+		}
 		*dst++ = *src++;
 	    }
+	    *dstLenPtr = srcLen;
+	    break;
 	}
-	*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;
+	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.
+	     */
 
-	srcStart = src;
+	    char *dstStart, *dstMax;
+	    CONST char *srcStart;
+	    
+	    dstStart = dst;
+	    dstMax = dst + *dstLenPtr;
 
-	if (srcLen < *dstLenPtr) {
-	    dstEnd = dst + srcLen;
-	} else {
-	    dstEnd = dst + *dstLenPtr;
-	}
-	while (dst < dstEnd) {
-	    if (*src == '\n') {
-		if (dstEnd < dstMax) {
-		    dstEnd++;
+	    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;
 		}
-		*dst++ = '\r';
-		newlineFound = 1;
+		*dst++ = *src++;
 	    }
-	    *dst++ = *src++;
+	    *srcLenPtr = src - srcStart;
+	    *dstLenPtr = dst - dstStart;
+	    break;
+	}
+	default: {
+	    break;
 	}
-	*srcLenPtr = src - srcStart;
-	*dstLenPtr = dst - dstStart;
-	break;
-    }
-    default:
-	break;
     }
     return newlineFound;
 }
@@ -4354,12 +3467,12 @@ TranslateOutputEOL(
  *
  * 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.
@@ -4368,15 +3481,13 @@ TranslateOutputEOL(
  */
 
 static int
-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. */
+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. */
 {
-    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.
@@ -4384,18 +3495,18 @@ CheckFlush(
      * 3. if it contains any output and this channel is unbuffered.
      */
 
-    if (!GotFlag(statePtr, BUFFER_READY)) {
-	if (IsBufferFull(bufPtr)) {
-	    SetFlag(statePtr, BUFFER_READY);
-	} else if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)) {
+    if ((statePtr->flags & BUFFER_READY) == 0) {
+	if (bufPtr->nextAdded == bufPtr->bufLength) {
+	    statePtr->flags |= BUFFER_READY;
+	} else if (statePtr->flags & CHANNEL_LINEBUFFERED) {
 	    if (newlineFlag != 0) {
-		SetFlag(statePtr, BUFFER_READY);
+		statePtr->flags |= BUFFER_READY;
 	    }
-	} else if (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
-	    SetFlag(statePtr, BUFFER_READY);
+	} else if (statePtr->flags & CHANNEL_UNBUFFERED) {
+	    statePtr->flags |= BUFFER_READY;
 	}
     }
-    if (GotFlag(statePtr, BUFFER_READY)) {
+    if (statePtr->flags & BUFFER_READY) {
 	if (FlushChannel(NULL, chanPtr, 0) != 0) {
 	    return -1;
 	}
@@ -4416,31 +3527,31 @@ CheckFlush(
  *	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(
-    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(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
 				 * must have initialized it and is responsible
 				 * for managing the storage. */
 {
     Tcl_Obj *objPtr;
     int charsStored, length;
-    const char *string;
+    char *string;
 
-    TclNewObj(objPtr);
+    objPtr = Tcl_NewObj();
     charsStored = Tcl_GetsObj(chan, objPtr);
     if (charsStored > 0) {
-	string = TclGetStringFromObj(objPtr, &length);
+	string = Tcl_GetStringFromObj(objPtr, &length);
 	Tcl_DStringAppend(lineRead, string, length);
     }
-    TclDecrRefCount(objPtr);
+    Tcl_DecrRefCount(objPtr);
     return charsStored;
 }
 
@@ -4450,71 +3561,60 @@ Tcl_Gets(
  * 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(
-    Tcl_Channel chan,		/* Channel from which to read. */
-    Tcl_Obj *objPtr)		/* The line read will be appended to this
+Tcl_GetsObj(chan, objPtr)
+    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.
      */
 
-    TclGetStringFromObj(objPtr, &oldLength);
+    Tcl_GetStringFromObj(objPtr, &oldLength);
     oldFlags = statePtr->inputEncodingFlags;
     oldState = statePtr->inputEncodingState;
     oldRemoved = BUFFER_PADDING;
@@ -4524,25 +3624,17 @@ Tcl_GetsObj(
 
     /*
      * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't
-     * produce ByteArray objects.
+     * produce ByteArray objects.  To avoid circularity problems,
+     * "iso8859-1" is builtin to Tcl.
      */
 
     if (encoding == NULL) {
-	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");
-	}
+	encoding = Tcl_GetEncoding(NULL, "iso8859-1");
     }
 
     /*
-     * 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;
@@ -4569,10 +3661,10 @@ Tcl_GetsObj(
 	    }
 	    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') {
@@ -4591,37 +3683,31 @@ Tcl_GetsObj(
 	 */
 
 	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;
 	    }
-	    break;
-	case TCL_TRANSLATE_CR:
-	    for (eol = dst; eol < dstEnd; eol++) {
-		if (*eol == '\r') {
-		    skip = 1;
-		    goto gotEOL;
+	    case TCL_TRANSLATE_CR: {
+		for (eol = dst; eol < dstEnd; eol++) {
+		    if (*eol == '\r') {
+			skip = 1;
+			goto goteol;
+		    }
 		}
+		break;
 	    }
-	    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) {
+	    case TCL_TRANSLATE_CRLF: {
+		for (eol = dst; eol < dstEnd; eol++) {
+		    if (*eol == '\r') {
+			eol++;
+			if (eol >= dstEnd) {
+			    int offset;
+			    
 			    offset = eol - objPtr->bytes;
 			    dst = dstEnd;
 			    if (FilterInputBytes(chanPtr, &gs) != 0) {
@@ -4629,92 +3715,91 @@ Tcl_GetsObj(
 			    }
 			    dstEnd = dst + gs.bytesWrote;
 			    eol = objPtr->bytes + offset;
+			    if (eol >= dstEnd) {
+				skip = 0;
+				goto goteol;
+			    }
 			}
-			if (eol >= dstEnd) {
-			    skip = 0;
-			    goto gotEOL;
+			if (*eol == '\n') {
+			    eol--;
+			    skip = 2;
+			    goto goteol;
 			}
 		    }
-		    if (*eol == '\n') {
-			eol--;
-			skip = 2;
-			goto gotEOL;
-		    }
-		}
-	    }
-	    break;
-	case TCL_TRANSLATE_AUTO:
-	    eol = dst;
-	    skip = 1;
-	    if (GotFlag(statePtr, 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, 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--;
 		}
+		break;
 	    }
-	    for (eol = dst; eol < dstEnd; eol++) {
-		if (*eol == '\r') {
-		    eol++;
-		    if (eol == dstEnd) {
+	    case TCL_TRANSLATE_AUTO: {
+		eol = dst;
+		skip = 1;
+		if (statePtr->flags & INPUT_SAW_CR) {
+		    statePtr->flags &= ~INPUT_SAW_CR;
+		    if (*eol == '\n') {
 			/*
-			 * If buffer ended on \r, peek ahead to see if a \n is
-			 * available, unless EOF char was found already.
+			 * Skip the raw bytes that make up the '\n'.
 			 */
 
-			if (eol != eof) {
-			    int offset;
+			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--;
+		    }
+		}
+		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.
+			     */
 
+			    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 >= dstEnd) {
-			    eol--;
-			    SetFlag(statePtr, INPUT_SAW_CR);
-			    goto gotEOL;
+			if (*eol == '\n') {
+			    skip++;
 			}
+			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;
-	    SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
+	    statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
-	if (GotFlag(statePtr, CHANNEL_EOF)) {
+	if (statePtr->flags & CHANNEL_EOF) {
 	    skip = 0;
 	    eol = dstEnd;
 	    if (eol == objPtr->bytes + oldLength) {
@@ -4724,38 +3809,29 @@ Tcl_GetsObj(
 		 */
 
 		Tcl_SetObjLength(objPtr, oldLength);
-		CommonGetsCleanup(chanPtr);
+		CommonGetsCleanup(chanPtr, encoding);
 		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.
-     */
-
-  gotEOL:
-    /*
-     * Regenerate the top channel, in case it was changed due to
-     * self-modifying reflected transforms.
+     * 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.
      */
-
-    chanPtr = statePtr->topChanPtr;
-
+     
+    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, RemovePoint(bufPtr), gs.rawRead,
-	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
+    Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
+	    gs.rawRead, statePtr->inputEncodingFlags,
+	    &statePtr->inputEncodingState, dst,
 	    eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
 	    &gs.charsWrote);
     bufPtr->nextRemoved += gs.rawRead;
@@ -4765,35 +3841,25 @@ Tcl_GetsObj(
      */
 
     Tcl_SetObjLength(objPtr, eol - objPtr->bytes);
-    CommonGetsCleanup(chanPtr);
-    ResetFlag(statePtr, CHANNEL_BLOCKED);
+    CommonGetsCleanup(chanPtr, encoding);
+    statePtr->flags &= ~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.
-     */
-
-  restore:
-    /*
-     * Regenerate the top channel, in case it was changed due to
-     * self-modifying reflected transforms.
+     * 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.
      */
 
-    chanPtr = statePtr->topChanPtr;
-
+    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);
+    CommonGetsCleanup(chanPtr, encoding);
 
     statePtr->inputEncodingState = oldState;
     statePtr->inputEncodingFlags = oldFlags;
@@ -4801,347 +3867,66 @@ Tcl_GetsObj(
 
     /*
      * 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);
+    statePtr->flags |= 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:
-    /*
-     * Regenerate the top channel, in case it was changed due to
-     * self-modifying reflected transforms.
-     */
-
-    chanPtr = statePtr->topChanPtr;
-
     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 (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-		if (GotFlag(statePtr, 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 (GotFlag(statePtr, 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.
-     */
-
-    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;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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(
-    Channel *chanPtr,		/* Channel to read. */
-    GetsState *gsPtr)		/* Current state of gets operation. */
+FilterInputBytes(chanPtr, gsPtr)
+    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, *dst;
-    int offset, toRead, dstNeeded, spaceLeft, result, rawLen;
+    char *raw, *rawStart, *rawEnd;
+    char *dst;
+    int offset, toRead, dstNeeded, spaceLeft, result, rawLen, length;
     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. */
@@ -5156,7 +3941,7 @@ FilterInputBytes(
     bufPtr = gsPtr->bufPtr;
     if (bufPtr != NULL) {
 	bufPtr->nextRemoved += gsPtr->rawRead;
-	if (!IsBufferReady(bufPtr)) {
+	if (bufPtr->nextRemoved >= bufPtr->nextAdded) {
 	    bufPtr = bufPtr->nextPtr;
 	}
     }
@@ -5164,20 +3949,20 @@ FilterInputBytes(
 
     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 (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-	    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+	read:
+        if (statePtr->flags & CHANNEL_BLOCKED) {
+            if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		gsPtr->charsWrote = 0;
 		gsPtr->rawRead = 0;
 		return -1;
 	    }
-	    ResetFlag(statePtr, CHANNEL_BLOCKED);
-	}
+            statePtr->flags &= ~CHANNEL_BLOCKED;
+        }
 	if (GetInput(chanPtr) != 0) {
 	    gsPtr->charsWrote = 0;
 	    gsPtr->rawRead = 0;
@@ -5188,14 +3973,15 @@ FilterInputBytes(
     }
 
     /*
-     * 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 = RemovePoint(bufPtr);
+    rawStart = bufPtr->buf + bufPtr->nextRemoved;
     raw = rawStart;
-    rawLen = BytesLeft(bufPtr);
+    rawEnd = bufPtr->buf + bufPtr->nextAdded;
+    rawLen = rawEnd - rawStart;
 
     dst = *gsPtr->dstPtr;
     offset = dst - objPtr->bytes;
@@ -5203,19 +3989,15 @@ FilterInputBytes(
     if (toRead > rawLen) {
 	toRead = rawLen;
     }
-    dstNeeded = toRead * TCL_UTF_MAX;
-    spaceLeft = objPtr->length - offset;
+    dstNeeded = toRead * TCL_UTF_MAX + 1;
+    spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
     if (dstNeeded > spaceLeft) {
-	int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
-
-	if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
+	length = offset * 2;
+	if (offset < dstNeeded) {
 	    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;
@@ -5223,45 +4005,44 @@ FilterInputBytes(
     gsPtr->state = statePtr->inputEncodingState;
     result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
 	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
-	    dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
+	    dst, spaceLeft, &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 (!IsBufferFull(bufPtr)) {
+	if (bufPtr->nextAdded < bufPtr->bufLength) {
 	    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 (GotFlag(statePtr, CHANNEL_EOF)) {
+	    } 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;
@@ -5273,8 +4054,8 @@ FilterInputBytes(
 		statePtr->inQueueTail = nextPtr;
 	    }
 	    extra = rawLen - gsPtr->rawRead;
-	    memcpy(nextPtr->buf + (BUFFER_PADDING - extra),
-		    raw + gsPtr->rawRead, (size_t) extra);
+	    memcpy((VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
+		    (VOID *) (raw + gsPtr->rawRead), (size_t) extra);
 	    nextPtr->nextRemoved -= extra;
 	    bufPtr->nextAdded -= extra;
 	}
@@ -5289,9 +4070,9 @@ FilterInputBytes(
  *
  * 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
@@ -5307,14 +4088,13 @@ FilterInputBytes(
  */
 
 static void
-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. */
+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. */
 {
-    ChannelState *statePtr = chanPtr->state;
-				/* State info for channel */
+    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
     ChannelBuffer *bufPtr;
     Tcl_DriverBlockModeProc *blockModeProc;
     int bytesLeft;
@@ -5323,24 +4103,24 @@ PeekAhead(
 
     /*
      * 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 = BytesLeft(bufPtr) - gsPtr->rawRead;
+	bytesLeft = bufPtr->nextAdded - (bufPtr->nextRemoved + gsPtr->rawRead);
 	if (bytesLeft == 0) {
-	    if (!IsBufferFull(bufPtr)) {
+	    if (bufPtr->nextAdded < bufPtr->bufLength) {
 		/*
 		 * Don't peek ahead if last read was short read.
 		 */
-
+		 
 		goto cleanup;
 	    }
-	    if (!GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+	    if ((statePtr->flags & CHANNEL_NONBLOCKING) == 0) {
 		blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
 		if (blockModeProc == NULL) {
 		    /*
@@ -5361,7 +4141,7 @@ PeekAhead(
     }
     return;
 
-  cleanup:
+    cleanup:
     bufPtr->nextRemoved += gsPtr->rawRead;
     gsPtr->rawRead = 0;
     gsPtr->totalChars += gsPtr->charsWrote;
@@ -5374,8 +4154,8 @@ PeekAhead(
  *
  * 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.
@@ -5385,19 +4165,19 @@ PeekAhead(
  *
  *---------------------------------------------------------------------------
  */
-
+ 
 static void
-CommonGetsCleanup(
-    Channel *chanPtr)
+CommonGetsCleanup(chanPtr, encoding)
+    Channel *chanPtr;
+    Tcl_Encoding encoding;
 {
-    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 (IsBufferReady(bufPtr)) {
+	if (bufPtr->nextRemoved < bufPtr->nextAdded) {
 	    break;
 	}
 	RecycleBuffer(statePtr, bufPtr, 0);
@@ -5409,20 +4189,20 @@ CommonGetsCleanup(
 	/*
 	 * 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 = SpaceLeft(bufPtr);
+	    extra = bufPtr->bufLength - bufPtr->nextAdded;
 	    if (extra > 0) {
-		memcpy(InsertPoint(bufPtr),
-			nextPtr->buf + (BUFFER_PADDING - extra),
+		memcpy((VOID *) (bufPtr->buf + bufPtr->nextAdded),
+			(VOID *) (nextPtr->buf + BUFFER_PADDING - extra),
 			(size_t) extra);
 		bufPtr->nextAdded += extra;
 		nextPtr->nextRemoved = BUFFER_PADDING;
@@ -5430,6 +4210,9 @@ CommonGetsCleanup(
 	    bufPtr = nextPtr;
 	}
     }
+    if (statePtr->encoding == NULL) {
+	Tcl_FreeEncoding(encoding);
+    }
 }
 
 /*
@@ -5437,16 +4220,16 @@ CommonGetsCleanup(
  *
  * Tcl_Read --
  *
- *	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.
+ *	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.
  *
  *	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.
@@ -5455,14 +4238,13 @@ CommonGetsCleanup(
  */
 
 int
-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. */
+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. */
 {
-    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.
@@ -5474,7 +4256,7 @@ Tcl_Read(
 	return -1;
     }
 
-    return DoRead(chanPtr, dst, bytesToRead, 0);
+    return DoRead(chanPtr, dst, bytesToRead);
 }
 
 /*
@@ -5482,16 +4264,16 @@ Tcl_Read(
  *
  * Tcl_ReadRaw --
  *
- *	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.
+ *	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.
  *
  *	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.
@@ -5500,22 +4282,22 @@ Tcl_Read(
  */
 
 int
-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. */
+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. */
 {
-    Channel *chanPtr = (Channel *) chan;
-    ChannelState *statePtr = chanPtr->state;
-				/* State info for channel */
-    int nread, result, copied, copiedNow;
+    Channel *chanPtr = (Channel *) chan;		
+    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
+    int nread, result;
+    int 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
@@ -5527,109 +4309,102 @@ Tcl_ReadRaw(
     }
 
     /*
-     * 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 (GotFlag(statePtr, CHANNEL_EOF)) {
+        copiedNow = CopyBuffer(chanPtr, bufPtr + copied,
+                bytesToRead - copied);
+        if (copiedNow == 0) {
+            if (statePtr->flags & CHANNEL_EOF) {
 		goto done;
-	    }
-	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+            }
+            if (statePtr->flags & CHANNEL_BLOCKED) {
+                if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		    goto done;
-		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
-	    }
+                }
+                statePtr->flags &= (~(CHANNEL_BLOCKED));
+            }
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	    /*
-	     * [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 (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
-		    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-		    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
-		/*
-		 * We bypass the driver; it would block as no data is
-		 * available.
-		 */
+	    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+		(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+		!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
 
-		nread = -1;
-		result = EWOULDBLOCK;
-	    } else
+	        /* We bypass the driver, it would block, as no data is available */
+	        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 = ChanRead(chanPtr, 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)) {
-		    SetFlag(statePtr, CHANNEL_BLOCKED);
+            
+	        if (nread < (bytesToRead - copied)) {
+		    statePtr->flags |= CHANNEL_BLOCKED;
 		}
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-		if (nread <= (bytesToRead - copied)) {
-		    /*
-		     * [Bug 943274] We have read the available data, clear
-		     * flag.
-		     */
-
-		    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
+	        if (nread <= (bytesToRead - copied)) {
+		    /* [SF Tcl Bug 943274] We have read the available
+		     * data, clear flag */
+		    statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
 		}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 	    } else if (nread == 0) {
-		SetFlag(statePtr, CHANNEL_EOF);
+	        statePtr->flags |= 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;
 		    }
 
-		    SetFlag(statePtr, CHANNEL_BLOCKED);
+		    statePtr->flags |= CHANNEL_BLOCKED;
 		    result = EAGAIN;
 		}
 
 		Tcl_SetErrno(result);
 		return -1;
-	    }
+	    } 
 
 	    return copied + nread;
-	}
+        }
     }
 
-  done:
+done:
     return copied;
 }
 
@@ -5638,39 +4413,39 @@ Tcl_ReadRaw(
  *
  * 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(
-    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(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,
 				 * 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.
      */
@@ -5678,53 +4453,52 @@ Tcl_ReadChars(
     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(
-    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(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,
 				 * 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;
@@ -5734,30 +4508,28 @@ DoReadChars(
      * 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).
 	     */
-
-	    TclGetString(objPtr);
+	    Tcl_GetString(objPtr);
 	}
 	offset = 0;
     } else {
 	if (encoding == NULL) {
 	    Tcl_GetByteArrayFromObj(objPtr, &offset);
 	} else {
-	    TclGetStringFromObj(objPtr, &offset);
+	    Tcl_GetStringFromObj(objPtr, &offset);
 	}
     }
 
@@ -5776,9 +4548,10 @@ DoReadChars(
 	     */
 
 	    bufPtr = statePtr->inQueueHead;
-	    if (IsBufferEmpty(bufPtr)) {
-		ChannelBuffer *nextPtr = bufPtr->nextPtr;
+	    if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+		ChannelBuffer *nextPtr;
 
+		nextPtr = bufPtr->nextPtr;
 		RecycleBuffer(statePtr, bufPtr, 0);
 		statePtr->inQueueHead = nextPtr;
 		if (nextPtr == NULL) {
@@ -5786,16 +4559,15 @@ DoReadChars(
 		}
 	    }
 	}
-
 	if (copiedNow < 0) {
-	    if (GotFlag(statePtr, CHANNEL_EOF)) {
+	    if (statePtr->flags & CHANNEL_EOF) {
 		break;
 	    }
-	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+	    if (statePtr->flags & CHANNEL_BLOCKED) {
+		if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		    break;
 		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
+		statePtr->flags &= ~CHANNEL_BLOCKED;
 	    }
 	    result = GetInput(chanPtr);
 	    if (result != 0) {
@@ -5810,49 +4582,41 @@ DoReadChars(
 	    toRead -= copiedNow;
 	}
     }
-
-    ResetFlag(statePtr, CHANNEL_BLOCKED);
+    statePtr->flags &= ~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:
-    /*
-     * Regenerate the top channel, in case it was changed due to
-     * self-modifying reflected transforms.
-     */
-
-    chanPtr = statePtr->topChanPtr;
-
     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.
@@ -5861,24 +4625,25 @@ DoReadChars(
  */
 
 static int
-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
+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
 				 * 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;
@@ -5886,9 +4651,9 @@ ReadBytes(
 
     offset = *offsetPtr;
 
-    bufPtr = statePtr->inQueueHead;
-    src = RemovePoint(bufPtr);
-    srcLen = BytesLeft(bufPtr);
+    bufPtr = statePtr->inQueueHead; 
+    src = bufPtr->buf + bufPtr->nextRemoved;
+    srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
 
     toRead = bytesToRead;
     if ((unsigned) toRead > (unsigned) srcLen) {
@@ -5898,9 +4663,9 @@ ReadBytes(
     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;
@@ -5911,8 +4676,8 @@ ReadBytes(
     }
     dst += offset;
 
-    if (GotFlag(statePtr, INPUT_NEED_NL)) {
-	ResetFlag(statePtr, INPUT_NEED_NL);
+    if (statePtr->flags & INPUT_NEED_NL) {
+	statePtr->flags &= ~INPUT_NEED_NL;
 	if ((srcLen == 0) || (*src != '\n')) {
 	    *dst = '\r';
 	    *offsetPtr += 1;
@@ -5941,21 +4706,21 @@ ReadBytes(
  *
  * 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.
- *
- *	'charsToRead' can safely be a very large number because space is only
- *	allocated to hold data read from the channel as needed.
+ *	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' may *not* be 0.
+ *	'charsToRead' 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 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.
@@ -5964,31 +4729,31 @@ ReadBytes(
  */
 
 static int
-ReadChars(
-    ChannelState *statePtr,	/* State of channel to read. */
-    Tcl_Obj *objPtr,		/* Input data is appended to this object.
+ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr)
+    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, srcLen, dstNeeded;
+    int toRead, factor, offset, spaceLeft, length, srcLen, dstNeeded;
     int srcRead, dstWrote, numChars, dstRead;
     ChannelBuffer *bufPtr;
     char *src, *dst;
@@ -5998,48 +4763,45 @@ ReadChars(
     factor = *factorPtr;
     offset = *offsetPtr;
 
-    bufPtr = statePtr->inQueueHead;
-    src = RemovePoint(bufPtr);
-    srcLen = BytesLeft(bufPtr);
+    bufPtr = statePtr->inQueueHead; 
+    src    = bufPtr->buf + bufPtr->nextRemoved;
+    srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
 
     toRead = charsToRead;
-    if ((unsigned) toRead > (unsigned) srcLen) {
+    if ((unsigned)toRead > (unsigned)srcLen) {
 	toRead = srcLen;
     }
 
     /*
-     * '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 = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
-    spaceLeft = objPtr->length - offset;
+    dstNeeded = toRead * factor / UTF_EXPANSION_FACTOR;
+    spaceLeft = objPtr->length - offset - TCL_UTF_MAX - 1;
 
     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.
 	 */
 
-	int length = offset + ((offset < dstNeeded) ? dstNeeded : offset);
-
-	if (Tcl_AttemptSetObjLength(objPtr, length) == 0) {
+	length = offset * 2;
+	if (offset < dstNeeded) {
 	    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;
@@ -6047,69 +4809,72 @@ ReadChars(
     dst = objPtr->bytes + offset;
 
     /*
-     * [Bug 1462248]: The cause of the crash reported in this bug is this:
+     * SF Tcl Bug 1462248
+     * The cause of the crash reported in the referenced 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;
-    if (GotFlag(statePtr, INPUT_NEED_NL)) {
+    if (statePtr->flags & INPUT_NEED_NL) {
 	/*
 	 * We want a '\n' because the last character we saw was '\r'.
 	 */
 
-	ResetFlag(statePtr, INPUT_NEED_NL);
+	statePtr->flags &= ~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';
@@ -6120,64 +4885,67 @@ ReadChars(
 	if (encEndFlagSuppressed) {
 	    statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 	}
-	return 1;
+        return 1;
     }
 
     Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
 	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
-	    dstNeeded + 1, &srcRead, &dstWrote, &numChars);
+	    dstNeeded + TCL_UTF_MAX, &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. [Bug 478856]
+		 * file event can be delivered.
 		 *
-		 * 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.
+		 * SF #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.
 		 */
 
-		SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+	        statePtr->flags |= 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(RemovePoint(nextPtr), src, (size_t) srcLen);
+	memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
+		(size_t) srcLen);
 	RecycleBuffer(statePtr, bufPtr, 0);
 	statePtr->inQueueHead = nextPtr;
 	return ReadChars(statePtr, objPtr, charsToRead, offsetPtr, factorPtr);
@@ -6186,12 +4954,12 @@ ReadChars(
     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;
 	}
@@ -6200,23 +4968,24 @@ ReadChars(
 		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;
+    numChars -= (dstRead - dstWrote);
 
     if ((unsigned) numChars > (unsigned) toRead) {
 	/*
 	 * Got too many chars.
 	 */
 
-	const char *eof = Tcl_UtfAtIndex(dst, toRead);
+	CONST char *eof;
 
+	eof = Tcl_UtfAtIndex(dst, toRead);
 	statePtr->inputEncodingState = oldState;
 	Tcl_ExternalToUtf(NULL, statePtr->encoding, src, srcLen,
 		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
@@ -6240,12 +5009,12 @@ ReadChars(
  *
  * 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.
@@ -6254,23 +5023,23 @@ ReadChars(
  */
 
 static int
-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
+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
 				 * 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;
 
@@ -6278,14 +5047,15 @@ TranslateInputEOL(
     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 = srcStart + *srcLenPtr;
+	CONST char *src, *srcMax;
 
+	srcMax = srcStart + *srcLenPtr;
 	for (src = srcStart; src < srcMax; src++) {
 	    if (*src == inEofChar) {
 		eof = src;
@@ -6299,104 +5069,106 @@ TranslateInputEOL(
 	}
     }
     switch (statePtr->inputTranslation) {
-    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';
+	case TCL_TRANSLATE_LF: {
+	    if (dstStart != srcStart) {
+		memcpy((VOID *) dstStart, (VOID *) srcStart, (size_t) dstLen);
 	    }
+	    srcLen = dstLen;
+	    break;
 	}
-	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++;
+	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';
+		}
+	    }
+	    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 {
-		    *dst++ = '\r';
+		    *dst++ = *src++;
 		}
-	    } else {
-		*dst++ = *src++;
 	    }
+	    srcLen = src - srcStart;
+	    dstLen = dst - dstStart;
+	    break;
 	}
-	srcLen = src - srcStart;
-	dstLen = dst - dstStart;
-	break;
-    }
-    case TCL_TRANSLATE_AUTO: {
-	char *dst;
-	const char *src, *srcEnd, *srcMax;
+	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 (GotFlag(statePtr, INPUT_SAW_CR) && (src < srcMax)) {
-	    if (*src == '\n') {
-		src++;
+	    if ((statePtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+		if (*src == '\n') {
+		    src++;
+		}
+		statePtr->flags &= ~INPUT_SAW_CR;
 	    }
-	    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++;
-		    }
+	    for ( ; src < srcEnd; ) {
+		if (*src == '\r') {
 		    src++;
+		    if (src >= srcMax) {
+			statePtr->flags |= INPUT_SAW_CR;
+		    } else if (*src == '\n') {
+			if (srcEnd < srcMax) {
+			    srcEnd++;
+			}
+			src++;
+		    }
+		    *dst++ = '\n';
+		} else {
+		    *dst++ = *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.
 	 */
 
-	SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
+	statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
-	ResetFlag(statePtr, INPUT_SAW_CR | INPUT_NEED_NL);
+	statePtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
 	return 1;
     }
 
@@ -6409,8 +5181,8 @@ TranslateInputEOL(
  *
  * 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.
@@ -6422,17 +5194,17 @@ TranslateInputEOL(
  */
 
 int
-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. */
+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. */    
 {
     Channel *chanPtr;		/* The real IO channel. */
     ChannelState *statePtr;	/* State of actual channel. */
     ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
-    int flags;
+    int i, flags;
 
     chanPtr = (Channel *) chan;
     statePtr = chanPtr->state;
@@ -6446,7 +5218,7 @@ Tcl_Ungets(
     /*
      * CheckChannelErrors clears too many flag bits in this one case.
      */
-
+     
     flags = statePtr->flags;
     if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
 	len = -1;
@@ -6455,40 +5227,42 @@ Tcl_Ungets(
     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 (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
+    if (statePtr->flags & CHANNEL_STICKY_EOF) {
 	goto done;
     }
-    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_EOF);
+    statePtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_EOF));
 
     bufPtr = AllocChannelBuffer(len);
-    memcpy(InsertPoint(bufPtr), str, (size_t) len);
-    bufPtr->nextAdded += len;
+    for (i = 0; i < len; i++) {
+        bufPtr->buf[bufPtr->nextAdded++] = str[i];
+    }
 
-    if (statePtr->inQueueHead == NULL) {
-	bufPtr->nextPtr = NULL;
-	statePtr->inQueueHead = bufPtr;
-	statePtr->inQueueTail = bufPtr;
+    if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+        bufPtr->nextPtr = (ChannelBuffer *) NULL;
+        statePtr->inQueueHead = bufPtr;
+        statePtr->inQueueTail = bufPtr;
     } else if (atEnd) {
-	bufPtr->nextPtr = NULL;
-	statePtr->inQueueTail->nextPtr = bufPtr;
-	statePtr->inQueueTail = bufPtr;
+        bufPtr->nextPtr = (ChannelBuffer *) 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;
 }
@@ -6510,14 +5284,12 @@ Tcl_Ungets(
  */
 
 int
-Tcl_Flush(
-    Tcl_Channel chan)		/* The Channel to flush. */
+Tcl_Flush(chan)
+    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.
@@ -6533,13 +5305,14 @@ Tcl_Flush(
      * Force current output buffer to be output also.
      */
 
-    if ((statePtr->curOutPtr != NULL) && IsBufferReady(statePtr->curOutPtr)) {
-	SetFlag(statePtr, BUFFER_READY);
+    if ((statePtr->curOutPtr != NULL)
+	    && (statePtr->curOutPtr->nextAdded > 0)) {
+        statePtr->flags |= BUFFER_READY;
     }
-
+    
     result = FlushChannel(NULL, chanPtr, 0);
     if (result != 0) {
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
 
     return TCL_OK;
@@ -6550,8 +5323,8 @@ Tcl_Flush(
  *
  * 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.
@@ -6564,31 +5337,32 @@ Tcl_Flush(
  */
 
 static void
-DiscardInputQueued(
-    ChannelState *statePtr,	/* Channel on which to discard the queued
-				 * input. */
-    int discardSavedBuffers)	/* If non-zero, discard all buffers including
-				 * last one. */
+DiscardInputQueued(statePtr, discardSavedBuffers)
+    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 = NULL;
-    statePtr->inQueueTail = NULL;
-    for (; bufPtr != NULL; bufPtr = nxtPtr) {
-	nxtPtr = bufPtr->nextPtr;
-	RecycleBuffer(statePtr, bufPtr, discardSavedBuffers);
+    statePtr->inQueueHead = (ChannelBuffer *) NULL;
+    statePtr->inQueueTail = (ChannelBuffer *) NULL;
+    for (; bufPtr != (ChannelBuffer *) 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 && statePtr->saveInBufPtr != NULL) {
-	ckfree(statePtr->saveInBufPtr);
-	statePtr->saveInBufPtr = NULL;
+    
+    if (discardSavedBuffers) {
+        if (statePtr->saveInBufPtr != (ChannelBuffer *) NULL) {
+            ckfree((char *) statePtr->saveInBufPtr);
+            statePtr->saveInBufPtr = (ChannelBuffer *) NULL;
+        }
     }
 }
 
@@ -6597,11 +5371,11 @@ DiscardInputQueued(
  *
  * 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.
@@ -6610,15 +5384,14 @@ DiscardInputQueued(
  */
 
 static int
-GetInput(
-    Channel *chanPtr)		/* Channel to read input from. */
+GetInput(chanPtr)
+    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
@@ -6626,91 +5399,90 @@ GetInput(
      * 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 != NULL) {
-	if (statePtr->inQueueHead != NULL) {
+    if (chanPtr->inQueueHead != (ChannelBuffer*) NULL) {
+        if (statePtr->inQueueHead != (ChannelBuffer*) NULL) {
 	    RecycleBuffer(statePtr, statePtr->inQueueHead, 0);
-	    statePtr->inQueueHead = NULL;
+	    statePtr->inQueueHead = (ChannelBuffer*) NULL;
 	}
 
 	statePtr->inQueueHead = chanPtr->inQueueHead;
 	statePtr->inQueueTail = chanPtr->inQueueTail;
-	chanPtr->inQueueHead = NULL;
-	chanPtr->inQueueTail = NULL;
+	chanPtr->inQueueHead  = (ChannelBuffer*) NULL;
+	chanPtr->inQueueTail  = (ChannelBuffer*) 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) && !IsBufferFull(bufPtr)) {
-	toRead = SpaceLeft(bufPtr);
+    if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
+        toRead = bufPtr->bufLength - bufPtr->nextAdded;
     } 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(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 = NULL;
+        bufPtr->nextPtr = (ChannelBuffer *) 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 = SpaceLeft(bufPtr);
+	toRead = bufPtr->bufLength - bufPtr->nextAdded;
 
-	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;
     }
 
     /*
@@ -6718,62 +5490,62 @@ GetInput(
      * platforms it is impossible to read from a device after EOF.
      */
 
-    if (GotFlag(statePtr, CHANNEL_EOF)) {
+    if (statePtr->flags & CHANNEL_EOF) {
 	return 0;
     }
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    /*
-     * [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 (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !GotFlag(statePtr, CHANNEL_HAS_MORE_DATA)) {
-	/*
-	 * Bypass the driver, it would block, as no data is available
-	 */
+    if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+	!(statePtr->flags & CHANNEL_HAS_MORE_DATA)) {
 
-	nread = -1;
-	result = EWOULDBLOCK;
-    } else
+        /* Bypass the driver, it would block, as no data is available */
+        nread = -1;
+        result = EWOULDBLOCK;
+    } else {
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-    {
-	nread = ChanRead(chanPtr, InsertPoint(bufPtr), toRead, &result);
+
+        nread = (chanPtr->typePtr->inputProc)(chanPtr->instanceData,
+		    bufPtr->buf + bufPtr->nextAdded, toRead, &result);
+
+#ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
     }
+#endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
     if (nread > 0) {
 	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) {
-	    SetFlag(statePtr, CHANNEL_BLOCKED);
+	    statePtr->flags |= CHANNEL_BLOCKED;
 	}
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
 	if (nread <= toRead) {
-	    /*
-	     * [Bug 943274]: We have read the available data, clear flag.
-	     */
-
-	    ResetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
+	  /* [SF Tcl Bug 943274] We have read the available data,
+	   * clear flag */
+	  statePtr->flags &= ~CHANNEL_HAS_MORE_DATA;
 	}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
+
     } else if (nread == 0) {
-	SetFlag(statePtr, CHANNEL_EOF);
+	statePtr->flags |= CHANNEL_EOF;
 	statePtr->inputEncodingFlags |= TCL_ENCODING_END;
     } else if (nread < 0) {
 	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
-	    SetFlag(statePtr, CHANNEL_BLOCKED);
+	    statePtr->flags |= CHANNEL_BLOCKED;
 	    result = EAGAIN;
 	}
 	Tcl_SetErrno(result);
@@ -6787,12 +5559,12 @@ GetInput(
  *
  * 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.
@@ -6801,32 +5573,30 @@ GetInput(
  */
 
 Tcl_WideInt
-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? */
+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? */
 {
-    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
-				 * non-blocking mode after the seek. */
+    int wasAsync;		/* Was the channel nonblocking before the
+                                 * seek operation? If so, must restore to
+                                 * nonblocking 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)) {
@@ -6844,22 +5614,22 @@ Tcl_Seek(
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == NULL) {
-	Tcl_SetErrno(EINVAL);
-	return Tcl_LongAsWide(-1);
+    if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) 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);
     }
 
     /*
@@ -6868,85 +5638,90 @@ Tcl_Seek(
      */
 
     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.
      */
 
-    ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
-	    INPUT_SAW_CR);
-
+    statePtr->flags &=
+        (~(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 (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
-	wasAsync = 1;
-	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
+    if (statePtr->flags & CHANNEL_NONBLOCKING) {
+        wasAsync = 1;
+        result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
 	if (result != 0) {
 	    return Tcl_LongAsWide(-1);
 	}
-	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
-	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
-	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
-	}
-    }
-
-    /*
-     * 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);
+        statePtr->flags &= (~(CHANNEL_NONBLOCKING));
+        if (statePtr->flags & BG_FLUSH_SCHEDULED) {
+            statePtr->flags &= (~(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 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.
-	 */
 
-	curPos = ChanSeek(chanPtr, offset, mode, &result);
+        /*
+         * 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) {
+	    curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
+		    offset, mode, &result);
+	} else if (offset < Tcl_LongAsWide(LONG_MIN) ||
+		offset > Tcl_LongAsWide(LONG_MAX)) {
+	    result = EOVERFLOW;
+	    curPos = Tcl_LongAsWide(-1);
+	} else {
+	    curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
+		    chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
+		    &result));
+	}
 	if (curPos == Tcl_LongAsWide(-1)) {
 	    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) {
-	SetFlag(statePtr, CHANNEL_NONBLOCKING);
-	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
+        statePtr->flags |= CHANNEL_NONBLOCKING;
+        result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
 	if (result != 0) {
 	    return Tcl_LongAsWide(-1);
 	}
@@ -6960,13 +5735,13 @@ Tcl_Seek(
  *
  * 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.
@@ -6975,17 +5750,14 @@ Tcl_Seek(
  */
 
 Tcl_WideInt
-Tcl_Tell(
-    Tcl_Channel chan)		/* The channel to return pos for. */
+Tcl_Tell(chan)
+    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);
@@ -6994,8 +5766,8 @@ Tcl_Tell(
     /*
      * 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)) {
@@ -7013,33 +5785,44 @@ Tcl_Tell(
      * defined. This means that the channel does not support seeking.
      */
 
-    if (chanPtr->typePtr->seekProc == NULL) {
-	Tcl_SetErrno(EINVAL);
-	return Tcl_LongAsWide(-1);
+    if (chanPtr->typePtr->seekProc == (Tcl_DriverSeekProc *) 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);
+    }
+
     /*
-     * 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...
      */
 
-    curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
+    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
+	    chanPtr->typePtr->wideSeekProc != NULL) {
+	curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
+		Tcl_LongAsWide(0), SEEK_CUR, &result);
+    } else {
+	curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
+		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;
 }
@@ -7049,9 +5832,9 @@ Tcl_Tell(
  *
  * 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
@@ -7064,97 +5847,26 @@ Tcl_Tell(
  */
 
 int
-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_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_WideInt wOffset, wResult;
 
-    wOffset = Tcl_LongAsWide((long) offset);
+    wOffset = Tcl_LongAsWide((long)offset);
     wResult = Tcl_Seek(chan, wOffset, mode);
-    return (int) Tcl_WideAsLong(wResult);
+    return (int)Tcl_WideAsLong(wResult);
 }
 
 int
-Tcl_TellOld(
-    Tcl_Channel chan)		/* The channel to return pos for. */
+Tcl_TellOld(chan)
+    Tcl_Channel chan;		/* The channel to return pos for. */
 {
-    Tcl_WideInt wResult = Tcl_Tell(chan);
+    Tcl_WideInt wResult;
 
-    return (int) Tcl_WideAsLong(wResult);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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 (!GotFlag(chanPtr->state, 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.
-     */
-
-    WillWrite(chanPtr);
-
-    if (WillRead(chanPtr) < 0) {
-        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;
+    wResult = Tcl_Tell(chan);
+    return (int)Tcl_WideAsLong(wResult);
 }
 
 /*
@@ -7162,26 +5874,26 @@ Tcl_TruncateChannel(
  *
  * 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(
-    ChannelState *statePtr,	/* Channel to check. */
-    int flags)			/* Test if channel supports desired operation:
-				 * TCL_READABLE, TCL_WRITABLE. Also indicates
+CheckChannelErrors(statePtr, flags)
+    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);
 
@@ -7190,30 +5902,20 @@ CheckChannelErrors(
      */
 
     if (statePtr->unreportedError != 0) {
-	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;
+        Tcl_SetErrno(statePtr->unreportedError);
+        statePtr->unreportedError = 0;
+        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 (GotFlag(statePtr, CHANNEL_CLOSED) && !(flags & CHANNEL_RAW_MODE)) {
-	Tcl_SetErrno(EACCES);
-	return -1;
+    if ((statePtr->flags & CHANNEL_CLOSED) &&
+	    ((flags & CHANNEL_RAW_MODE) == 0)) {
+        Tcl_SetErrno(EACCES);
+        return -1;
     }
 
     /*
@@ -7221,8 +5923,8 @@ CheckChannelErrors(
      */
 
     if ((statePtr->flags & direction) == 0) {
-	Tcl_SetErrno(EACCES);
-	return -1;
+        Tcl_SetErrno(EACCES);
+        return -1;
     }
 
     /*
@@ -7233,23 +5935,23 @@ CheckChannelErrors(
      * retrieving and transforming the data to copy.
      */
 
-    if (BUSY_STATE(statePtr, flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
+    if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) {
 	Tcl_SetErrno(EBUSY);
 	return -1;
     }
 
     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 (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
-	    ResetFlag(statePtr, CHANNEL_EOF);
+	if ((statePtr->flags & CHANNEL_STICKY_EOF) == 0) {
+	    statePtr->flags &= ~CHANNEL_EOF;
 	}
-	ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+	statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
     }
 
     return 0;
@@ -7272,15 +5974,15 @@ CheckChannelErrors(
  */
 
 int
-Tcl_Eof(
-    Tcl_Channel chan)		/* Does this channel have EOF? */
+Tcl_Eof(chan)
+    Tcl_Channel chan;			/* Does this channel have EOF? */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-				/* State of real channel structure. */
+					/* State of real channel structure. */
 
-    return (GotFlag(statePtr, CHANNEL_STICKY_EOF) ||
-	    (GotFlag(statePtr, CHANNEL_EOF) &&
-	    (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
+    return ((statePtr->flags & CHANNEL_STICKY_EOF) ||
+            ((statePtr->flags & CHANNEL_EOF) &&
+		    (Tcl_InputBuffered(chan) == 0))) ? 1 : 0;
 }
 
 /*
@@ -7300,13 +6002,13 @@ Tcl_Eof(
  */
 
 int
-Tcl_InputBlocked(
-    Tcl_Channel chan)		/* Is this channel blocked? */
+Tcl_InputBlocked(chan)
+    Tcl_Channel chan;			/* Is this channel blocked? */
 {
     ChannelState *statePtr = ((Channel *) chan)->state;
-				/* State of real channel structure. */
+					/* State of real channel structure. */
 
-    return GotFlag(statePtr, CHANNEL_BLOCKED) ? 1 : 0;
+    return (statePtr->flags & CHANNEL_BLOCKED) ? 1 : 0;
 }
 
 /*
@@ -7314,12 +6016,12 @@ Tcl_InputBlocked(
  *
  * 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.
@@ -7328,26 +6030,28 @@ Tcl_InputBlocked(
  */
 
 int
-Tcl_InputBuffered(
-    Tcl_Channel chan)		/* The channel to query. */
+Tcl_InputBuffered(chan)
+    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 != NULL;
-	    bufPtr = bufPtr->nextPtr) {
-	bytesBuffered += BytesLeft(bufPtr);
+    for (bytesBuffered = 0, bufPtr = statePtr->inQueueHead;
+	 bufPtr != (ChannelBuffer *) NULL;
+	 bufPtr = bufPtr->nextPtr) {
+        bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
     }
 
     /*
      * Don't forget the bytes in the topmost pushback area.
      */
 
-    for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL;
-	    bufPtr = bufPtr->nextPtr) {
-	bytesBuffered += BytesLeft(bufPtr);
+    for (bufPtr = statePtr->topChanPtr->inQueueHead;
+	 bufPtr != (ChannelBuffer *) NULL;
+	 bufPtr = bufPtr->nextPtr) {
+        bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
     }
 
     return bytesBuffered;
@@ -7358,12 +6062,12 @@ Tcl_InputBuffered(
  *
  * 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.
@@ -7372,24 +6076,24 @@ Tcl_InputBuffered(
  */
 
 int
-Tcl_OutputBuffered(
-    Tcl_Channel chan)		/* The channel to query. */
+Tcl_OutputBuffered(chan)
+    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 != NULL;
-	    bufPtr = bufPtr->nextPtr) {
-	bytesBuffered += BytesLeft(bufPtr);
+    for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead;
+	bufPtr != (ChannelBuffer *) NULL;
+	bufPtr = bufPtr->nextPtr) {
+	bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
     }
-    if (statePtr->curOutPtr != NULL) {
-	register ChannelBuffer *curOutPtr = statePtr->curOutPtr;
-
-	if (IsBufferReady(curOutPtr)) {
-	    bytesBuffered += BytesLeft(curOutPtr);
-	}
+    if ((statePtr->curOutPtr != (ChannelBuffer *) NULL) &&
+	(statePtr->curOutPtr->nextAdded > statePtr->curOutPtr->nextRemoved)) {
+	statePtr->flags |= BUFFER_READY;
+	bytesBuffered +=
+	    (statePtr->curOutPtr->nextAdded - statePtr->curOutPtr->nextRemoved);
     }
 
     return bytesBuffered;
@@ -7404,8 +6108,8 @@ Tcl_OutputBuffered(
  *	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.
@@ -7414,17 +6118,18 @@ Tcl_OutputBuffered(
  */
 
 int
-Tcl_ChannelBuffered(
-    Tcl_Channel chan)		/* The channel to query. */
+Tcl_ChannelBuffered(chan)
+    Tcl_Channel chan;			/* The channel to query. */
 {
     Channel *chanPtr = (Channel *) chan;
-				/* Real channel structure. */
+					/* real channel structure. */
     ChannelBuffer *bufPtr;
-    int bytesBuffered = 0;
+    int bytesBuffered;
 
-    for (bufPtr = chanPtr->inQueueHead; bufPtr != NULL;
-	    bufPtr = bufPtr->nextPtr) {
-	bytesBuffered += BytesLeft(bufPtr);
+    for (bytesBuffered = 0, bufPtr = chanPtr->inQueueHead;
+	 bufPtr != (ChannelBuffer *) NULL;
+	 bufPtr = bufPtr->nextPtr) {
+        bytesBuffered += (bufPtr->nextAdded - bufPtr->nextRemoved);
     }
 
     return bytesBuffered;
@@ -7435,8 +6140,8 @@ Tcl_ChannelBuffered(
  *
  * 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.
@@ -7448,31 +6153,33 @@ Tcl_ChannelBuffered(
  */
 
 void
-Tcl_SetChannelBufferSize(
-    Tcl_Channel chan,		/* The channel whose buffer size to set. */
-    int sz)			/* The size to set. */
+Tcl_SetChannelBufferSize(chan, sz)
+    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
      */
 
     if (sz < 1) {
-	sz = 1;
+      sz = 1;
     } else if (sz > MAX_CHANNEL_BUFFER_SIZE) {
-	sz = MAX_CHANNEL_BUFFER_SIZE;
+      sz = MAX_CHANNEL_BUFFER_SIZE;
     }
 
     statePtr = ((Channel *) chan)->state;
     statePtr->bufSize = sz;
 
     if (statePtr->outputStage != NULL) {
-	ckfree(statePtr->outputStage);
+	ckfree((char *) statePtr->outputStage);
 	statePtr->outputStage = NULL;
     }
-    if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
-	statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
+    if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+	statePtr->outputStage = (char *)
+	    ckalloc((unsigned) (statePtr->bufSize + 2));
     }
 }
 
@@ -7493,12 +6200,12 @@ Tcl_SetChannelBufferSize(
  */
 
 int
-Tcl_GetChannelBufferSize(
-    Tcl_Channel chan)		/* The channel for which to find the buffer
-				 * size. */
+Tcl_GetChannelBufferSize(chan)
+    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;
 }
@@ -7508,43 +6215,44 @@ Tcl_GetChannelBufferSize(
  *
  * 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(
-    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. */
+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 != NULL) {
-	const char *genericopt =
-		"blocking buffering buffersize encoding eofchar translation";
-	const char **argv;
-	int argc, i;
+    if (interp) {
+	CONST char *genericopt = 
+	    "blocking buffering buffersize encoding eofchar translation";
+	CONST char **argv;
+	int  argc, i;
 	Tcl_DString ds;
 
 	Tcl_DStringInit(&ds);
@@ -7553,20 +6261,20 @@ Tcl_BadChannelOption(
 	    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) {
-	    Tcl_Panic("malformed option list in channel driver");
+	    panic("malformed option list in channel driver");
 	}
 	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "bad option \"", optionName,
-		"\": should be one of ", NULL);
+	Tcl_AppendResult(interp, "bad option \"", optionName, 
+		"\": should be one of ", (char *) NULL);
 	argc--;
 	for (i = 0; i < argc; i++) {
-	    Tcl_AppendResult(interp, "-", argv[i], ", ", NULL);
+	    Tcl_AppendResult(interp, "-", argv[i], ", ", (char *) NULL);
 	}
-	Tcl_AppendResult(interp, "or -", argv[i], NULL);
+	Tcl_AppendResult(interp, "or -", argv[i], (char *) NULL);
 	Tcl_DStringFree(&ds);
-	ckfree(argv);
+	ckfree((char *) argv);
     }
     Tcl_SetErrno(EINVAL);
     return TCL_ERROR;
@@ -7577,40 +6285,39 @@ Tcl_BadChannelOption(
  *
  * 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(
-    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(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). */
 {
     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)) {
@@ -7628,60 +6335,65 @@ Tcl_GetChannelOption(
      */
 
     if (statePtr->csPtrR) {
-	flags = statePtr->csPtrR->readFlags;
+      flags = statePtr->csPtrR->readFlags;
     } else if (statePtr->csPtrW) {
-	flags = statePtr->csPtrW->writeFlags;
+      flags = statePtr->csPtrW->writeFlags;
     } else {
 	flags = statePtr->flags;
     }
 
     /*
-     * 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 == NULL) {
-	len = 0;
+    
+    if (optionName == (char *) NULL) {
+        len = 0;
     } else {
-	len = strlen(optionName);
+        len = strlen(optionName);
     }
-
-    if (len == 0 || HaveOpt(2, "-blocking")) {
-	if (len == 0) {
-	    Tcl_DStringAppendElement(dsPtr, "-blocking");
-	}
-	Tcl_DStringAppendElement(dsPtr,
+    
+    if ((len == 0) || ((len > 2) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-blocking", len) == 0))) {
+        if (len == 0) {
+            Tcl_DStringAppendElement(dsPtr, "-blocking");
+        }
+        Tcl_DStringAppendElement(dsPtr,
 		(flags & CHANNEL_NONBLOCKING) ? "0" : "1");
-	if (len > 0) {
-	    return TCL_OK;
-	}
+        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) || ((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 || 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) || ((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 || HaveOpt(2, "-encoding")) {
+    if ((len == 0) ||
+	    ((len > 2) && (optionName[1] == 'e') &&
+		    (strncmp(optionName, "-encoding", len) == 0))) {
 	if (len == 0) {
 	    Tcl_DStringAppendElement(dsPtr, "-encoding");
 	}
@@ -7695,111 +6407,108 @@ Tcl_GetChannelOption(
 	    return TCL_OK;
 	}
     }
-    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) ||
+            ((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 || 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 ((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 != NULL) {
+    if (chanPtr->typePtr->getOptionProc != (Tcl_DriverGetOptionProc *) 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, interp,
-		optionName, dsPtr);
+        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);
     }
 }
@@ -7812,8 +6521,8 @@ Tcl_GetChannelOption(
  *	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.
@@ -7822,19 +6531,17 @@ Tcl_GetChannelOption(
  */
 
 int
-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 */
+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 */
     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.
@@ -7842,17 +6549,18 @@ Tcl_SetChannelOption(
 
     if (statePtr->csPtrR || statePtr->csPtrW) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "unable to set channel options: "
-		    "background copy in progress", NULL);
+	    Tcl_AppendResult(interp,
+		    "unable to set channel options: background copy in progress",
+		    (char *) 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)) {
@@ -7867,44 +6575,50 @@ Tcl_SetChannelOption(
 
     len = strlen(optionName);
 
-    if (HaveOpt(2, "-blocking")) {
+    if ((len > 2) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-blocking", len) == 0)) {
 	int newMode;
-
-	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 (HaveOpt(7, "-buffering")) {
-	len = strlen(newValue);
-	if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
-	    ResetFlag(statePtr, 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);
+        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;
+            }
+        }
 	return TCL_OK;
-    } else if (HaveOpt(7, "-buffersize")) {
+    } else if ((len > 7) && (optionName[1] == 'b') &&
+            (strncmp(optionName, "-buffersize", len) == 0)) {
 	int newBufferSize;
-
 	if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetChannelBufferSize(chan, newBufferSize);
-    } else if (HaveOpt(2, "-encoding")) {
+    } else if ((len > 2) && (optionName[1] == 'e') &&
+	    (strncmp(optionName, "-encoding", len) == 0)) {
 	Tcl_Encoding encoding;
 
 	if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
@@ -7915,12 +6629,10 @@ Tcl_SetChannelOption(
 		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;
@@ -7932,81 +6644,78 @@ Tcl_SetChannelOption(
 	statePtr->inputEncodingFlags = TCL_ENCODING_START;
 	statePtr->outputEncodingState = NULL;
 	statePtr->outputEncodingFlags = TCL_ENCODING_START;
-	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
+	statePtr->flags &= ~CHANNEL_NEED_MORE_DATA;
 	UpdateInterest(chanPtr);
-    } 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(argv);
-		return TCL_ERROR;
-	    }
-	    if (GotFlag(statePtr, TCL_READABLE)) {
-		statePtr->inEofChar = inValue;
-	    }
-	    if (GotFlag(statePtr, 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(argv);
-	    return TCL_ERROR;
-	}
-	if (argv != NULL) {
-	    ckfree(argv);
-	}
+    } 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);
+        }
 
 	/*
-	 * [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.
+	 * [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.
 	 */
 
-	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
+	statePtr->flags &= (~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED));
+
 	return TCL_OK;
-    } else if (HaveOpt(1, "-translation")) {
-	const char *readMode, *writeMode;
+    } else if ((len > 1) && (optionName[1] == 't') &&
+            (strncmp(optionName, "-translation", len) == 0)) {
+	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) {
-	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
-	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
+        if (argc == 1) {
+	    readMode = (statePtr->flags & TCL_READABLE) ? argv[0] : NULL;
+	    writeMode = (statePtr->flags & TCL_WRITABLE) ? argv[0] : NULL;
 	} else if (argc == 2) {
-	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
-	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
+	    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", NULL);
-	    }
-	    ckfree(argv);
-	    return TCL_ERROR;
+            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 (readMode) {
 	    TclEolTranslation translation;
-
 	    if (*readMode == '\0') {
 		translation = statePtr->inputTranslation;
 	    } else if (strcmp(readMode, "auto") == 0) {
@@ -8014,7 +6723,7 @@ Tcl_SetChannelOption(
 	    } 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;
@@ -8027,23 +6736,24 @@ Tcl_SetChannelOption(
 	    } else {
 		if (interp) {
 		    Tcl_AppendResult(interp,
-			    "bad value for -translation: "
-			    "must be one of auto, binary, cr, lf, crlf,"
-			    " or platform", NULL);
+			    "bad value for -translation: ",
+			    "must be one of auto, binary, cr, lf, crlf,",
+			    " or platform", (char *) NULL);
 		}
-		ckfree(argv);
+		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;
-		ResetFlag(statePtr, INPUT_SAW_CR | CHANNEL_NEED_MORE_DATA);
+		statePtr->flags &= ~(INPUT_SAW_CR);
+		statePtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
 		UpdateInterest(chanPtr);
 	    }
 	}
@@ -8052,9 +6762,10 @@ Tcl_SetChannelOption(
 		/* 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) {
@@ -8065,7 +6776,7 @@ Tcl_SetChannelOption(
 	    } 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;
@@ -8078,21 +6789,21 @@ Tcl_SetChannelOption(
 	    } else {
 		if (interp) {
 		    Tcl_AppendResult(interp,
-			    "bad value for -translation: "
-			    "must be one of auto, binary, cr, lf, crlf,"
-			    " or platform", NULL);
+			    "bad value for -translation: ",
+			    "must be one of auto, binary, cr, lf, crlf,",
+			    " or platform", (char *) NULL);
 		}
-		ckfree(argv);
+		ckfree((char *) argv);
 		return TCL_ERROR;
 	    }
 	}
-	ckfree(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, NULL);
+	return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
     }
 
     /*
@@ -8103,12 +6814,14 @@ Tcl_SetChannelOption(
 	RecycleBuffer(statePtr, statePtr->saveInBufPtr, 1);
 	statePtr->saveInBufPtr = NULL;
     }
-    if ((statePtr->inQueueHead != NULL)
-	    && (statePtr->inQueueHead->nextPtr == NULL)
-	    && IsBufferEmpty(statePtr->inQueueHead)) {
-	RecycleBuffer(statePtr, statePtr->inQueueHead, 1);
-	statePtr->inQueueHead = NULL;
-	statePtr->inQueueTail = 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;
+	}
     }
 
     /*
@@ -8116,11 +6829,12 @@ Tcl_SetChannelOption(
      */
 
     if (statePtr->outputStage != NULL) {
-	ckfree(statePtr->outputStage);
+	ckfree((char *) statePtr->outputStage);
 	statePtr->outputStage = NULL;
     }
-    if ((statePtr->encoding != NULL) && GotFlag(statePtr, TCL_WRITABLE)) {
-	statePtr->outputStage = ckalloc(statePtr->bufSize + 2);
+    if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) {
+	statePtr->outputStage = (char *) 
+	    ckalloc((unsigned) (statePtr->bufSize + 2));
     }
     return TCL_OK;
 }
@@ -8130,10 +6844,11 @@ Tcl_SetChannelOption(
  *
  * 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.
@@ -8145,37 +6860,38 @@ Tcl_SetChannelOption(
  */
 
 static void
-CleanupChannelHandlers(
-    Tcl_Interp *interp,
-    Channel *chanPtr)
+CleanupChannelHandlers(interp, chanPtr)
+    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.
-     */
-
-    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;
-	    }
+     * 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, sPtr);
+            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+                    TclChannelEventScriptInvoker, (ClientData) sPtr);
 
-	    TclDecrRefCount(sPtr->scriptPtr);
-	    ckfree(sPtr);
-	} else {
-	    prevPtr = sPtr;
-	}
+	    Tcl_DecrRefCount(sPtr->scriptPtr);
+            ckfree((char *) sPtr);
+        } else {
+            prevPtr = sPtr;
+        }
     }
 }
 
@@ -8184,9 +6900,10 @@ CleanupChannelHandlers(
  *
  * 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.
@@ -8198,62 +6915,62 @@ CleanupChannelHandlers(
  */
 
 void
-Tcl_NotifyChannel(
-    Tcl_Channel channel,	/* Channel that detected an event. */
-    int mask)			/* OR'ed combination of TCL_READABLE,
+Tcl_NotifyChannel(channel, mask)
+    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;
-    const Tcl_ChannelType *upTypePtr;
+    Channel* upChanPtr;
+    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) &&
-	    GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
-	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
-	    !GotFlag(statePtr, CHANNEL_TIMER_FEV)) {
-	SetFlag(statePtr, CHANNEL_HAS_MORE_DATA);
+	(statePtr->flags & CHANNEL_NONBLOCKING) &&
+	(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL) &&
+	!(statePtr->flags & CHANNEL_TIMER_FEV)) {
+
+        statePtr->flags |= 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 != NULL)) {
-	Tcl_DriverHandlerProc *upHandlerProc;
+    while (mask && (chanPtr->upChanPtr != ((Channel*) 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);
+	    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;
@@ -8262,31 +6979,32 @@ Tcl_NotifyChannel(
     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(channel);
-    Tcl_Preserve(statePtr);
+     
+    Tcl_Preserve((ClientData) channel);
+    Tcl_Preserve((ClientData) 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 (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
+    if ((statePtr->flags & BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
 	FlushChannel(NULL, chanPtr, 1);
 	mask &= ~TCL_WRITABLE;
     }
@@ -8295,12 +7013,12 @@ Tcl_NotifyChannel(
      * Add this invocation to the list of recursive invocations of
      * ChannelHandlerEventProc.
      */
-
-    nh.nextHandlerPtr = NULL;
+    
+    nh.nextHandlerPtr = (ChannelHandler *) NULL;
     nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
     tsdPtr->nestedHandlerPtr = &nh;
 
-    for (chPtr = statePtr->chPtr; chPtr != NULL; ) {
+    for (chPtr = statePtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
 	/*
 	 * If this channel handler is interested in any of the events that
 	 * have occurred on the channel, invoke its procedure.
@@ -8308,7 +7026,7 @@ Tcl_NotifyChannel(
 
 	if ((chPtr->mask & mask) != 0) {
 	    nh.nextHandlerPtr = chPtr->nextPtr;
-	    chPtr->proc(chPtr->clientData, mask);
+	    (*(chPtr->proc))(chPtr->clientData, mask);
 	    chPtr = nh.nextHandlerPtr;
 	} else {
 	    chPtr = chPtr->nextPtr;
@@ -8316,17 +7034,17 @@ Tcl_NotifyChannel(
     }
 
     /*
-     * 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(statePtr);
-    Tcl_Release(channel);
+    Tcl_Release((ClientData) statePtr);
+    Tcl_Release((ClientData) channel);
 
     tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
 }
@@ -8336,8 +7054,8 @@ Tcl_NotifyChannel(
  *
  * 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.
@@ -8349,82 +7067,84 @@ Tcl_NotifyChannel(
  */
 
 static void
-UpdateInterest(
-    Channel *chanPtr)		/* Channel to update. */
+UpdateInterest(chanPtr)
+    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 (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
+    if (statePtr->flags & BG_FLUSH_SCHEDULED) {
 	mask |= TCL_WRITABLE;
     }
 
     /*
      * 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 (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
-		&& (statePtr->inQueueHead != NULL)
-		&& IsBufferReady(statePtr->inQueueHead)) {
+	if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
+		&& (statePtr->inQueueHead != (ChannelBuffer *) NULL)
+		&& (statePtr->inQueueHead->nextRemoved <
+			statePtr->inQueueHead->nextAdded)) {
 	    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
-	     *	 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 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,
-			chanPtr);
+			(ClientData) chanPtr);
 	    }
 	}
     }
-    ChanWatch(chanPtr, mask);
+    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
 }
 
 /*
@@ -8432,8 +7152,8 @@ UpdateInterest(
  *
  * 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.
@@ -8445,47 +7165,47 @@ UpdateInterest(
  */
 
 static void
-ChannelTimerProc(
-    ClientData clientData)
+ChannelTimerProc(clientData)
+    ClientData clientData;
 {
-    Channel *chanPtr = clientData;
-    ChannelState *statePtr = chanPtr->state;
-				/* State info for channel */
+    Channel *chanPtr = (Channel *) clientData;
+    ChannelState *statePtr = chanPtr->state;	/* state info for channel */
 
-    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
+    if (!(statePtr->flags & CHANNEL_NEED_MORE_DATA)
 	    && (statePtr->interestMask & TCL_READABLE)
-	    && (statePtr->inQueueHead != NULL)
-	    && IsBufferReady(statePtr->inQueueHead)) {
+	    && (statePtr->inQueueHead != (ChannelBuffer *) NULL)
+	    && (statePtr->inQueueHead->nextRemoved <
+		    statePtr->inQueueHead->nextAdded)) {
 	/*
-	 * 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,chanPtr);
+	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
+		(ClientData) 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 (GotFlag(statePtr, CHANNEL_NONBLOCKING) &&
-		(Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
-	    SetFlag(statePtr, CHANNEL_TIMER_FEV);
+	if ((statePtr->flags & CHANNEL_NONBLOCKING) &&
+	    (Tcl_ChannelBlockModeProc(chanPtr->typePtr) == NULL)) {
+	    statePtr->flags |= CHANNEL_TIMER_FEV;
 	}
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
-	Tcl_Preserve(statePtr);
-	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
+	Tcl_Preserve((ClientData) statePtr);
+	Tcl_NotifyChannel((Tcl_Channel)chanPtr, TCL_READABLE);
 
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-	ResetFlag(statePtr, CHANNEL_TIMER_FEV);
+	statePtr->flags &= ~CHANNEL_TIMER_FEV; 
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
 
-	Tcl_Release(statePtr);
+	Tcl_Release((ClientData) statePtr);
     } else {
 	statePtr->timer = NULL;
 	UpdateInterest(chanPtr);
@@ -8497,75 +7217,80 @@ ChannelTimerProc(
  *
  * 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(
-    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(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. */
 {
     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 != NULL; chPtr = chPtr->nextPtr) {
-	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
-		(chPtr->clientData == clientData)) {
-	    break;
-	}
+    for (chPtr = statePtr->chPtr;
+	 chPtr != (ChannelHandler *) NULL;
+	 chPtr = chPtr->nextPtr) {
+        if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
+                (chPtr->clientData == clientData)) {
+            break;
+        }
     }
-    if (chPtr == NULL) {
-	chPtr = ckalloc(sizeof(ChannelHandler));
-	chPtr->mask = 0;
-	chPtr->proc = proc;
-	chPtr->clientData = clientData;
-	chPtr->chanPtr = chanPtr;
-	chPtr->nextPtr = statePtr->chPtr;
-	statePtr->chPtr = chPtr;
+    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;
     }
 
     /*
-     * 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 != NULL; chPtr = chPtr->nextPtr) {
+    for (chPtr = statePtr->chPtr;
+	 chPtr != (ChannelHandler *) NULL;
+	 chPtr = chPtr->nextPtr) {
 	statePtr->interestMask |= chPtr->mask;
     }
 
@@ -8577,53 +7302,55 @@ Tcl_CreateChannelHandler(
  *
  * 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(
-    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(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. */
+    
 {
     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 = NULL, chPtr = statePtr->chPtr; chPtr != NULL;
-	    chPtr = chPtr->nextPtr) {
-	if ((chPtr->chanPtr == chanPtr) && (chPtr->clientData == clientData)
-		&& (chPtr->proc == proc)) {
-	    break;
-	}
-	prevChPtr = chPtr;
+    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;
     }
 
     /*
      * If not found, return without doing anything.
      */
 
-    if (chPtr == NULL) {
-	return;
+    if (chPtr == (ChannelHandler *) NULL) {
+        return;
     }
 
     /*
@@ -8631,32 +7358,36 @@ Tcl_DeleteChannelHandler(
      * process the next one instead - we are going to delete *this* one.
      */
 
-    for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;
-	    nhPtr = nhPtr->nestedHandlerPtr) {
-	if (nhPtr->nextHandlerPtr == chPtr) {
-	    nhPtr->nextHandlerPtr = chPtr->nextPtr;
-	}
+    for (nhPtr = tsdPtr->nestedHandlerPtr;
+	 nhPtr != (NextChannelHandler *) NULL;
+	 nhPtr = nhPtr->nestedHandlerPtr) {
+        if (nhPtr->nextHandlerPtr == chPtr) {
+            nhPtr->nextHandlerPtr = chPtr->nextPtr;
+        }
     }
 
     /*
      * Splice it out of the list of channel handlers.
      */
-
-    if (prevChPtr == NULL) {
-	statePtr->chPtr = chPtr->nextPtr;
+    
+    if (prevChPtr == (ChannelHandler *) NULL) {
+        statePtr->chPtr = chPtr->nextPtr;
     } else {
-	prevChPtr->nextPtr = chPtr->nextPtr;
+        prevChPtr->nextPtr = chPtr->nextPtr;
     }
-    ckfree(chPtr);
+    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 != NULL; chPtr = chPtr->nextPtr) {
-	statePtr->interestMask |= chPtr->mask;
+    for (chPtr = statePtr->chPtr;
+	 chPtr != (ChannelHandler *) NULL;
+	 chPtr = chPtr->nextPtr) {
+        statePtr->interestMask |= chPtr->mask;
     }
 
     UpdateInterest(statePtr->topChanPtr);
@@ -8667,8 +7398,8 @@ Tcl_DeleteChannelHandler(
  *
  * 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.
@@ -8680,36 +7411,36 @@ Tcl_DeleteChannelHandler(
  */
 
 static void
-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 */
+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 */
     EventScriptRecord *esPtr, *prevEsPtr;
 
-    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 {
-		CLANG_ASSERT(prevEsPtr);
-		prevEsPtr->nextPtr = esPtr->nextPtr;
-	    }
-
-	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
-		    TclChannelEventScriptInvoker, esPtr);
+    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;
+            }
 
-	    TclDecrRefCount(esPtr->scriptPtr);
-	    ckfree(esPtr);
+            Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
+                    TclChannelEventScriptInvoker, (ClientData) esPtr);
+            
+	    Tcl_DecrRefCount(esPtr->scriptPtr);
+            ckfree((char *) esPtr);
 
-	    break;
-	}
+            break;
+        }
     }
 }
 
@@ -8731,54 +7462,40 @@ DeleteScriptRecord(
  */
 
 static void
-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 */
+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 */
     EventScriptRecord *esPtr;
-    int makeCH;
 
-    for (esPtr=statePtr->scriptRecordPtr; esPtr!=NULL; esPtr=esPtr->nextPtr) {
-	if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
-	    TclDecrRefCount(esPtr->scriptPtr);
-	    esPtr->scriptPtr = NULL;
-	    break;
-	}
+    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;
+        }
     }
-
-    makeCH = (esPtr == NULL);
-
-    if (makeCH) {
-	esPtr = ckalloc(sizeof(EventScriptRecord));
+    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;
     }
-
-    /*
-     * 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);
-    }
 }
 
 /*
@@ -8786,9 +7503,9 @@ CreateScriptRecord(
  *
  * 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.
@@ -8800,46 +7517,46 @@ CreateScriptRecord(
  */
 
 void
-TclChannelEventScriptInvoker(
-    ClientData clientData,	/* The script+interp record. */
-    int mask)			/* Not used. */
+TclChannelEventScriptInvoker(clientData, mask)
+    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 = clientData;
-    chanPtr = esPtr->chanPtr;
-    mask = esPtr->mask;
-    interp = esPtr->interp;
+    esPtr	= (EventScriptRecord *) 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(interp);
+    
+    Tcl_Preserve((ClientData) interp);
     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_BackgroundException(interp, result);
+        Tcl_BackgroundError(interp);
     }
-    Tcl_Release(interp);
+    Tcl_Release((ClientData) interp);
 }
 
 /*
@@ -8847,10 +7564,10 @@ TclChannelEventScriptInvoker(
  *
  * 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.
@@ -8863,21 +7580,23 @@ TclChannelEventScriptInvoker(
 
 	/* ARGSUSED */
 int
-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. */
-    const char *chanName;
-    int modeIndex;		/* Index of mode argument. */
+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. */
+    char *chanName;
+    int modeIndex;			/* Index of mode argument. */
     int mask;
-    static const char *const modeOptions[] = {"readable", "writable", NULL};
-    static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
+    static CONST char *modeOptions[] = {"readable", "writable", NULL};
+    static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
 
     if ((objc != 3) && (objc != 4)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
@@ -8889,123 +7608,85 @@ Tcl_FileEventObjCmd(
     }
     mask = maskArray[modeIndex];
 
-    chanName = TclGetString(objv[1]);
+    chanName = Tcl_GetString(objv[1]);
     chan = Tcl_GetChannel(interp, chanName, NULL);
-    if (chan == NULL) {
+    if (chan == (Tcl_Channel) 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", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "channel is not ",
+                (mask == TCL_READABLE) ? "readable" : "writable",
+                (char *) NULL);
+        return TCL_ERROR;
     }
-
+    
     /*
      * If we are supposed to return the script, do so.
      */
 
     if (objc == 3) {
 	EventScriptRecord *esPtr;
-
-	for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL;
-		esPtr = esPtr->nextPtr) {
+	for (esPtr = statePtr->scriptRecordPtr;
+             esPtr != (EventScriptRecord *) 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 (*(TclGetString(objv[3])) == '\0') {
-	DeleteScriptRecord(interp, chanPtr, mask);
-	return TCL_OK;
+    if (*(Tcl_GetString(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
-TclCopyChannelOld(
-    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. */
-{
-    return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
-            cmdPtr);
-}
-
-int
-TclCopyChannel(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    Tcl_Channel inChan,		/* Channel to read from. */
-    Tcl_Channel outChan,	/* Channel to write to. */
-    Tcl_WideInt toRead,		/* Amount of data to copy, or -1 for all. */
-    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
+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. */
 {
     Channel *inPtr = (Channel *) inChan;
     Channel *outPtr = (Channel *) outChan;
@@ -9014,70 +7695,77 @@ TclCopyChannel(
     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 (BUSY_STATE(inStatePtr,TCL_READABLE)) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "channel \"",
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
 		    Tcl_GetChannelName(inChan), "\" is busy", NULL);
 	}
 	return TCL_ERROR;
     }
-    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
+    if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) {
 	if (interp) {
-	    Tcl_AppendResult(interp, "channel \"",
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(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) && (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;
+    }	    
+    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;
+		}
+	    }
+	}
     }
 
     /*
      * Make sure the output side is unbuffered.
      */
 
-    outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED)
-	    | CHANNEL_UNBUFFERED;
+    outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
+	| CHANNEL_UNBUFFERED;
 
     /*
      * 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 = 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 = (Tcl_WideInt) 0;
-    csPtr->interp = interp;
+    csPtr->toRead     = toRead;
+    csPtr->total      = 0;
+    csPtr->interp     = interp;
     if (cmdPtr) {
 	Tcl_IncrRefCount(cmdPtr);
     }
@@ -9087,16 +7775,6 @@ TclCopyChannel(
     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.
      */
 
@@ -9108,8 +7786,8 @@ TclCopyChannel(
  *
  * 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.
@@ -9121,20 +7799,19 @@ TclCopyChannel(
  */
 
 static int
-CopyData(
-    CopyState *csPtr,		/* State of copy operation. */
-    int mask)			/* Current channel event flags. */
+CopyData(csPtr, mask)
+    CopyState *csPtr;		/* State of copy operation. */
+    int mask;			/* Current channel event flags. */
 {
     Tcl_Interp *interp;
-    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;
+    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL;
     Tcl_Channel inChan, outChan;
     ChannelState *inStatePtr, *outStatePtr;
-    int result = TCL_OK, size, sizeb;
-    Tcl_WideInt total;
-    const char *buffer;
-    int inBinary, outBinary, sameEncoding;
-				/* Encoding control */
-    int underflow;		/* Input underflow */
+    int result = TCL_OK, size, total, sizeb;
+    char* buffer;
+
+    int inBinary, outBinary, sameEncoding; /* Encoding control */
+    int underflow;	/* input underflow */
 
     inChan	= (Tcl_Channel) csPtr->readPtr;
     outChan	= (Tcl_Channel) csPtr->writePtr;
@@ -9146,108 +7823,95 @@ CopyData(
     /*
      * 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)) {
-	TclNewObj(bufObj);
-	Tcl_IncrRefCount(bufObj);
+        bufObj = Tcl_NewObj ();
+	Tcl_IncrRefCount (bufObj);
     }
 
-    while (csPtr->toRead != (Tcl_WideInt) 0) {
+    while (csPtr->toRead != 0) {
 	/*
 	 * Check for unreported background errors.
 	 */
 
-	Tcl_GetChannelError(inChan, &msg);
-	if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {
+	if (inStatePtr->unreportedError != 0) {
 	    Tcl_SetErrno(inStatePtr->unreportedError);
 	    inStatePtr->unreportedError = 0;
 	    goto readError;
 	}
-	Tcl_GetChannelError(outChan, &msg);
-	if ((outStatePtr->unreportedError != 0) || (msg != NULL)) {
+	if (outStatePtr->unreportedError != 0) {
 	    Tcl_SetErrno(outStatePtr->unreportedError);
 	    outStatePtr->unreportedError = 0;
 	    goto writeError;
 	}
-
+	
 	if (cmdPtr && (mask == 0)) {
 	    /*
 	     * In async mode, we skip reading synchronously and fake an
 	     * underflow instead to prime the readable fileevent.
 	     */
 
-	    size = 0;
+	    size      = 0;
 	    underflow = 1;
 	} else {
 	    /*
 	     * Read up to bufSize bytes.
 	     */
 
-	    if ((csPtr->toRead == (Tcl_WideInt) -1)
-                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
-		sizeb = csPtr->bufSize;
+	    if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
+	        sizeb = csPtr->bufSize;
 	    } else {
-		sizeb = (int) csPtr->toRead;
+	        sizeb = csPtr->toRead;
 	    }
 
 	    if (inBinary || sameEncoding) {
-		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
-                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
+	        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:
-	    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);
-	    }
+	    readError:
+	    errObj = Tcl_NewObj();
+	    Tcl_AppendStringsToObj(errObj, "error reading \"",
+		    Tcl_GetChannelName(inChan), "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
 	    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 (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) &&
-                !(mask & TCL_READABLE)) {
+	    if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
+		!(mask & TCL_READABLE)) {
 		if (mask & TCL_WRITABLE) {
-		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
+		    Tcl_DeleteChannelHandler(outChan, CopyEventProc,
+			    (ClientData) csPtr);
 		}
-		Tcl_CreateChannelHandler(inChan, TCL_READABLE, CopyEventProc,
-			csPtr);
+		Tcl_CreateChannelHandler(inChan, TCL_READABLE,
+			CopyEventProc, (ClientData) csPtr);
 	    }
 	    if (size == 0) {
-		if (bufObj != NULL) {
-		    TclDecrRefCount(bufObj);
-		    bufObj = NULL;
+	        if (bufObj != (Tcl_Obj*) NULL) {
+		    Tcl_DecrRefCount (bufObj);
+		    bufObj = (Tcl_Obj*) NULL;
 		}
 		return TCL_OK;
 	    }
@@ -9261,7 +7925,7 @@ CopyData(
 	    buffer = csPtr->buffer;
 	    sizeb = size;
 	} else {
-	    buffer = TclGetStringFromObj(bufObj, &sizeb);
+	    buffer = Tcl_GetStringFromObj (bufObj, &sizeb);
 	}
 
 	if (outBinary || sameEncoding) {
@@ -9283,29 +7947,19 @@ CopyData(
 	 */
 
 	if (sizeb < 0) {
-	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);
-	    }
+	    writeError:
+	    errObj = Tcl_NewObj();
+	    Tcl_AppendStringsToObj(errObj, "error writing \"",
+		    Tcl_GetChannelName(outChan), "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
 	    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.
+	 * 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) {
@@ -9317,91 +7971,89 @@ CopyData(
 	 * 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 && GotFlag(outStatePtr, BG_FLUSH_SCHEDULED)) {
+	if ( ! underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED) ) {
 	    if (!(mask & TCL_WRITABLE)) {
 		if (mask & TCL_READABLE) {
-		    Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
+		    Tcl_DeleteChannelHandler(inChan, CopyEventProc,
+			    (ClientData) csPtr);
 		}
 		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
-			CopyEventProc, csPtr);
+			CopyEventProc, (ClientData) csPtr);
 	    }
-	    if (bufObj != NULL) {
-		TclDecrRefCount(bufObj);
-		bufObj = NULL;
+	    if (bufObj != (Tcl_Obj*) NULL) {
+	        Tcl_DecrRefCount (bufObj);
+		bufObj = (Tcl_Obj*) 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,
-			csPtr);
+		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
+			CopyEventProc, (ClientData) csPtr);
 	    }
-	    if (bufObj != NULL) {
-		TclDecrRefCount(bufObj);
-		bufObj = NULL;
+	    if (bufObj != (Tcl_Obj*) NULL) {
+	        Tcl_DecrRefCount (bufObj);
+		bufObj = (Tcl_Obj*) NULL;
 	    }
 	    return TCL_OK;
 	}
     } /* while */
 
-    if (bufObj != NULL) {
-	TclDecrRefCount(bufObj);
-	bufObj = NULL;
+    if (bufObj != (Tcl_Obj*) NULL) {
+        Tcl_DecrRefCount (bufObj);
+	bufObj = (Tcl_Obj*) 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(interp);
+	Tcl_Preserve((ClientData) interp);
 
-	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));
+	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
 	if (errObj) {
 	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
 	}
-	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
-	if (code != TCL_OK) {
-	    Tcl_BackgroundException(interp, code);
+	if (Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
+	    Tcl_BackgroundError(interp);
 	    result = TCL_ERROR;
 	}
-	TclDecrRefCount(cmdPtr);
-	Tcl_Release(interp);
+	Tcl_DecrRefCount(cmdPtr);
+	Tcl_Release((ClientData) interp);
     } else {
 	StopCopy(csPtr);
 	if (interp) {
@@ -9410,7 +8062,7 @@ CopyData(
 		result = TCL_ERROR;
 	    } else {
 		Tcl_ResetResult(interp);
-		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(total));
+		Tcl_SetIntObj(Tcl_GetObjResult(interp), total);
 	    }
 	}
     }
@@ -9422,12 +8074,13 @@ CopyData(
  *
  * DoRead --
  *
- *	Reads a given number of bytes from a channel. No encoding conversions
- *	are applied to the bytes being read.
+ *	Reads a given number of bytes from a channel.
+ *
+ *	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.
@@ -9436,65 +8089,60 @@ CopyData(
  */
 
 static int
-DoRead(
-    Channel *chanPtr,		/* The channel from which to read. */
-    char *bufPtr,		/* Where to store input read. */
-    int toRead,			/* Maximum number of bytes to read. */
-    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
-{
-    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(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? */
     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 (!GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
-	ResetFlag(statePtr, CHANNEL_EOF);
+    if (!(statePtr->flags & CHANNEL_STICKY_EOF)) {
+        statePtr->flags &= ~CHANNEL_EOF;
     }
-    ResetFlag(statePtr, CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
-
+    statePtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+    
     for (copied = 0; copied < toRead; copied += copiedNow) {
-	copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
-		toRead - copied);
-	if (copiedNow == 0) {
-	    if (GotFlag(statePtr, CHANNEL_EOF)) {
+        copiedNow = CopyAndTranslateBuffer(statePtr, bufPtr + copied,
+                toRead - copied);
+        if (copiedNow == 0) {
+            if (statePtr->flags & CHANNEL_EOF) {
 		goto done;
-	    }
-	    if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
-		if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+            }
+            if (statePtr->flags & CHANNEL_BLOCKED) {
+                if (statePtr->flags & CHANNEL_NONBLOCKING) {
 		    goto done;
-		}
-		ResetFlag(statePtr, CHANNEL_BLOCKED);
-	    }
-	    result = GetInput(chanPtr);
-	    if (result != 0) {
-		if (result != EAGAIN) {
-		    copied = -1;
-		}
+                }
+                statePtr->flags &= (~(CHANNEL_BLOCKED));
+            }
+            result = GetInput(chanPtr);
+            if (result != 0) {
+                if (result != EAGAIN) {
+                    copied = -1;
+                }
 		goto done;
-	    }
-	} else if (allowShortReads) {
-            copied += copiedNow;
-            break;
+            }
         }
     }
 
-    ResetFlag(statePtr, CHANNEL_BLOCKED);
+    statePtr->flags &= (~(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;
 }
@@ -9504,13 +8152,13 @@ DoRead(
  *
  * 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.
@@ -9519,208 +8167,220 @@ DoRead(
  */
 
 static int
-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? */
+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? */
 {
     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 == NULL) {
-	return 0;
+    
+    if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+        return 0;
     }
     bufPtr = statePtr->inQueueHead;
-    bytesInBuffer = BytesLeft(bufPtr);
+    bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
 
     copied = 0;
     switch (statePtr->inputTranslation) {
-    case TCL_TRANSLATE_LF:
-	if (bytesInBuffer == 0) {
-	    return 0;
-	}
-
-	/*
-	 * Copy the current chunk into the result buffer.
-	 */
-
-	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.
-	 */
+        case TCL_TRANSLATE_LF: {
+            if (bytesInBuffer == 0) {
+                return 0;
+            }
 
-	if (bytesInBuffer < space) {
-	    space = bytesInBuffer;
-	}
-	memcpy(result, RemovePoint(bufPtr), (size_t) space);
-	bufPtr->nextRemoved += space;
-	copied = space;
+	    /*
+             * Copy the current chunk into the result buffer.
+             */
 
-	for (end = result + copied; result < end; result++) {
-	    if (*result == '\r') {
-		*result = '\n';
+	    if (bytesInBuffer < space) {
+		space = bytesInBuffer;
 	    }
+	    memcpy((VOID *) result,
+		    (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+		    (size_t) space);
+	    bufPtr->nextRemoved += space;
+	    copied = space;
+            break;
 	}
-	break;
-    }
-    case TCL_TRANSLATE_CRLF: {
-	char *src, *end, *dst;
-	int curByte;
-
-	/*
-	 * If there is a held-back "\r" at EOF, produce it now.
-	 */
+        case TCL_TRANSLATE_CR: {
+	    char *end;
+	    
+            if (bytesInBuffer == 0) {
+                return 0;
+            }
 
-	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 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(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 (GotFlag(statePtr, INPUT_SAW_CR)) {
-		ResetFlag(statePtr, INPUT_SAW_CR);
-		*dst = '\r';
-		dst++;
-	    }
-	    if (curByte == '\r') {
-		SetFlag(statePtr, INPUT_SAW_CR);
-	    } else {
-		*dst = (char) curByte;
-		dst++;
+            /*
+             * 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++;
+		}
 	    }
+	    copied = dst - result;
+	    break;
 	}
-	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".
-	 */
+        case TCL_TRANSLATE_AUTO: {
+	    char *src, *end, *dst;
+	    int curByte;
+	
+            if (bytesInBuffer == 0) {
+                return 0;
+            }
 
-	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') || !GotFlag(statePtr, INPUT_SAW_CR)) {
-		    *dst = (char) curByte;
+            /*
+             * 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';
 		    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.
 		 */
-
-		SetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF);
+		
+		statePtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
 		statePtr->inputEncodingFlags |= TCL_ENCODING_END;
 		copied = i;
-		break;
-	    }
-	}
+                break;
+            }
+        }
     }
 
     /*
      * If the current buffer is empty recycle it.
      */
 
-    if (IsBufferEmpty(bufPtr)) {
-	statePtr->inQueueHead = bufPtr->nextPtr;
-	if (statePtr->inQueueHead == NULL) {
-	    statePtr->inQueueTail = NULL;
-	}
-	RecycleBuffer(statePtr, bufPtr, 0);
+    if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+        statePtr->inQueueHead = bufPtr->nextPtr;
+        if (statePtr->inQueueHead == (ChannelBuffer *) NULL) {
+            statePtr->inQueueTail = (ChannelBuffer *) 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;
@@ -9734,8 +8394,8 @@ CopyAndTranslateBuffer(
  *	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.
@@ -9744,39 +8404,39 @@ CopyAndTranslateBuffer(
  */
 
 static int
-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? */
+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? */
 {
     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 == NULL) {
-	return 0;
+    
+    if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+        return 0;
     }
     bufPtr = chanPtr->inQueueHead;
-    bytesInBuffer = BytesLeft(bufPtr);
+    bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
 
     copied = 0;
 
     if (bytesInBuffer == 0) {
-	RecycleBuffer(chanPtr->state, bufPtr, 0);
-	chanPtr->inQueueHead = NULL;
-	chanPtr->inQueueTail = NULL;
-	return 0;
+        RecycleBuffer(chanPtr->state, bufPtr, 0);
+	chanPtr->inQueueHead = (ChannelBuffer*) NULL;
+	chanPtr->inQueueTail = (ChannelBuffer*) NULL;
+        return 0;
     }
 
     /*
@@ -9784,29 +8444,31 @@ CopyBuffer(
      */
 
     if (bytesInBuffer < space) {
-	space = bytesInBuffer;
+        space = bytesInBuffer;
     }
 
-    memcpy(result, RemovePoint(bufPtr), (size_t) space);
+    memcpy((VOID *) result,
+	   (VOID *) (bufPtr->buf + bufPtr->nextRemoved),
+	   (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 (IsBufferEmpty(bufPtr)) {
-	chanPtr->inQueueHead = bufPtr->nextPtr;
-	if (chanPtr->inQueueHead == NULL) {
-	    chanPtr->inQueueTail = NULL;
-	}
-	RecycleBuffer(chanPtr->state, bufPtr, 0);
+    if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+        chanPtr->inQueueHead = bufPtr->nextPtr;
+        if (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+            chanPtr->inQueueTail = (ChannelBuffer *) NULL;
+        }
+        RecycleBuffer(chanPtr->state, bufPtr, 0);
     }
 
     /*
@@ -9838,28 +8500,29 @@ CopyBuffer(
  */
 
 static int
-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? */
+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? */
     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
@@ -9867,7 +8530,7 @@ DoWrite(
      */
 
     crsent = 0;
-
+    
     /*
      * Loop filling buffers and flushing them until all output has been
      * consumed.
@@ -9877,96 +8540,97 @@ DoWrite(
     totalDestCopied = 0;
 
     while (srcLen > 0) {
-	/*
-	 * Make sure there is a current output buffer to accept output.
-	 */
-
-	if (statePtr->curOutPtr == NULL) {
-	    statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
-	}
+        
+        /*
+         * Make sure there is a current output buffer to accept output.
+         */
 
-	outBufPtr = statePtr->curOutPtr;
+        if (statePtr->curOutPtr == (ChannelBuffer *) NULL) {
+            statePtr->curOutPtr = AllocChannelBuffer(statePtr->bufSize);
+        }
 
-	destCopied = SpaceLeft(outBufPtr);
-	if (destCopied > srcLen) {
-	    destCopied = srcLen;
-	}
+        outBufPtr = statePtr->curOutPtr;
 
-	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.
-	 */
+        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");
+        }
 
-	outBufPtr->nextAdded += destCopied;
-	if (!GotFlag(statePtr, BUFFER_READY)) {
-	    if (IsBufferFull(outBufPtr)) {
-		SetFlag(statePtr, BUFFER_READY);
-	    } else if (GotFlag(statePtr, 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 (GotFlag(statePtr, CHANNEL_UNBUFFERED)) {
-		SetFlag(statePtr, BUFFER_READY);
-	    }
-	}
+        /*
+         * 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.
+         */
 
-	totalDestCopied += srcCopied;
-	src += srcCopied;
-	srcLen -= srcCopied;
+        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 (GotFlag(statePtr, BUFFER_READY)) {
-	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
-		return -1;
-	    }
-	}
+        if (statePtr->flags & BUFFER_READY) {
+            if (FlushChannel(NULL, chanPtr, 0) != 0) {
+                return -1;
+            }
+        }
     } /* Closes "while" */
 
     return totalDestCopied;
@@ -9977,9 +8641,9 @@ DoWrite(
  *
  * 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.
@@ -9991,11 +8655,11 @@ DoWrite(
  */
 
 static void
-CopyEventProc(
-    ClientData clientData,
-    int mask)
+CopyEventProc(clientData, mask)
+    ClientData clientData;
+    int mask;
 {
-    (void) CopyData(clientData, mask);
+    (void) CopyData((CopyState *)clientData, mask);
 }
 
 /*
@@ -10009,15 +8673,15 @@ CopyEventProc(
  *	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(
-    CopyState *csPtr)		/* State for bg copy to stop . */
+StopCopy(csPtr)
+    CopyState *csPtr;		/* State for bg copy to stop . */
 {
     ChannelState *inStatePtr, *outStatePtr;
     int nonBlocking;
@@ -10026,41 +8690,41 @@ StopCopy(
 	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.
      */
 
-    nonBlocking = csPtr->readFlags & CHANNEL_NONBLOCKING;
+    nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
     if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
 	SetBlockMode(NULL, csPtr->readPtr,
 		nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
     }
     if (csPtr->readPtr != csPtr->writePtr) {
-	nonBlocking = csPtr->writeFlags & CHANNEL_NONBLOCKING;
+	nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING);
 	if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
 	    SetBlockMode(NULL, csPtr->writePtr,
 		    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
 	}
     }
-    ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
+    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,
-		csPtr);
+	Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->readPtr, CopyEventProc,
+		(ClientData)csPtr);
 	if (csPtr->readPtr != csPtr->writePtr) {
-	    Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
-		    CopyEventProc, csPtr);
+	    Tcl_DeleteChannelHandler((Tcl_Channel)csPtr->writePtr,
+		    CopyEventProc, (ClientData)csPtr);
 	}
-	TclDecrRefCount(csPtr->cmdPtr);
+        Tcl_DecrRefCount(csPtr->cmdPtr);
     }
-    inStatePtr->csPtrR = NULL;
+    inStatePtr->csPtrR  = NULL;
     outStatePtr->csPtrW = NULL;
-    ckfree(csPtr);
+    ckfree((char*) csPtr);
 }
 
 /*
@@ -10068,23 +8732,23 @@ StopCopy(
  *
  * 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(
-    Channel *chanPtr,		/* Channel to modify. */
-    int mode)			/* One of TCL_MODE_BLOCKING or
+StackSetBlockMode(chanPtr, mode)
+    Channel *chanPtr;		/* Channel to modify. */
+    int mode;			/* One of TCL_MODE_BLOCKING or
 				 * TCL_MODE_NONBLOCKING. */
 {
     int result = 0;
@@ -10095,10 +8759,10 @@ StackSetBlockMode(
      */
 
     chanPtr = chanPtr->state->topChanPtr;
-    while (chanPtr != NULL) {
+    while (chanPtr != (Channel *) NULL) {
 	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
 	if (blockModeProc != NULL) {
-	    result = blockModeProc(chanPtr->instanceData, mode);
+	    result = (*blockModeProc) (chanPtr->instanceData, mode);
 	    if (result != 0) {
 		Tcl_SetErrno(result);
 		return result;
@@ -10114,64 +8778,41 @@ StackSetBlockMode(
  *
  * 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(
-    Tcl_Interp *interp,		/* Interp for error reporting. */
-    Channel *chanPtr,		/* Channel to modify. */
-    int mode)			/* One of TCL_MODE_BLOCKING or
+SetBlockMode(interp, chanPtr, mode)
+    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 != 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);
+	if (interp != (Tcl_Interp *) NULL) {
+	    Tcl_AppendResult(interp, "error setting blocking mode: ",
+		    Tcl_PosixError(interp), (char *) NULL);
 	}
 	return TCL_ERROR;
     }
     if (mode == TCL_MODE_BLOCKING) {
-	ResetFlag(statePtr, CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED);
+	statePtr->flags &= (~(CHANNEL_NONBLOCKING | BG_FLUSH_SCHEDULED));
     } else {
-	SetFlag(statePtr, CHANNEL_NONBLOCKING);
+	statePtr->flags |= CHANNEL_NONBLOCKING;
     }
     return TCL_OK;
 }
@@ -10193,10 +8834,10 @@ SetBlockMode(
  */
 
 int
-Tcl_GetChannelNames(
-    Tcl_Interp *interp)		/* Interp for error reporting. */
+Tcl_GetChannelNames(interp)
+    Tcl_Interp *interp;		/* Interp for error reporting. */
 {
-    return Tcl_GetChannelNamesEx(interp, NULL);
+    return Tcl_GetChannelNamesEx(interp, (char *) NULL);
 }
 
 /*
@@ -10204,9 +8845,9 @@ Tcl_GetChannelNames(
  *
  * 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.
@@ -10218,45 +8859,35 @@ Tcl_GetChannelNames(
  */
 
 int
-Tcl_GetChannelNamesEx(
-    Tcl_Interp *interp,		/* Interp for error reporting. */
-    const char *pattern)	/* Pattern to filter on. */
+Tcl_GetChannelNamesEx(interp, pattern)
+    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 == NULL) {
+    if (interp == (Tcl_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);
 
-    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 != (Tcl_HashEntry *) NULL;
+	 hPtr = Tcl_NextHashEntry(&hSearch)) {
 
-    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";
@@ -10264,24 +8895,18 @@ Tcl_GetChannelNamesEx(
 	    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;
 }
 
@@ -10290,8 +8915,8 @@ Tcl_GetChannelNamesEx(
  *
  * 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.
@@ -10303,33 +8928,32 @@ Tcl_GetChannelNamesEx(
  */
 
 int
-Tcl_IsChannelRegistered(
-    Tcl_Interp *interp,		/* The interp to query of the channel */
-    Tcl_Channel chan)		/* The channel to check */
+Tcl_IsChannelRegistered (interp, chan)
+     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_GetAssocData(interp, "tclIO", NULL);
-    if (hTblPtr == NULL) {
-	return 0;
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        return 0;
     }
     hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
-    if (hPtr == NULL) {
-	return 0;
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return 0;
     }
     if ((Channel *) Tcl_GetHashValue(hPtr) != chanPtr) {
-	return 0;
+        return 0;
     }
 
     return 1;
@@ -10352,11 +8976,11 @@ Tcl_IsChannelRegistered(
  */
 
 int
-Tcl_IsChannelShared(
-    Tcl_Channel chan)		/* The channel to query */
+Tcl_IsChannelShared (chan)
+    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);
 }
@@ -10367,8 +8991,8 @@ Tcl_IsChannelShared(
  * 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).
@@ -10380,18 +9004,19 @@ Tcl_IsChannelShared(
  */
 
 int
-Tcl_IsChannelExisting(
-    const char *chanName)	/* The name of the channel to look for. */
+Tcl_IsChannelExisting(chanName)
+    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";
@@ -10401,8 +9026,10 @@ Tcl_IsChannelExisting(
 	    name = statePtr->channelName;
 	}
 
+	/* Bug 2333466. Include \0 in the compare to prevent partial matching on prefixes.
+	 */
 	if ((*chanName == *name) &&
-		(memcmp(name, chanName, (size_t) chanNameLen + 1) == 0)) {
+		(memcmp(name, chanName, (size_t) chanNameLen+1) == 0)) {
 	    return 1;
 	}
     }
@@ -10426,9 +9053,9 @@ Tcl_IsChannelExisting(
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_ChannelName(
-    const Tcl_ChannelType *chanTypePtr) /* Pointer to channel type. */
+CONST char *
+Tcl_ChannelName(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->typeName;
 }
@@ -10450,9 +9077,8 @@ Tcl_ChannelName(
  */
 
 Tcl_ChannelTypeVersion
-Tcl_ChannelVersion(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelVersion(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
 	return TCL_CHANNEL_VERSION_2;
@@ -10460,14 +9086,11 @@ Tcl_ChannelVersion(
 	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;
     }
 }
@@ -10490,13 +9113,13 @@ Tcl_ChannelVersion(
  */
 
 static int
-HaveVersion(
-    const Tcl_ChannelType *chanTypePtr,
-    Tcl_ChannelTypeVersion minimumVersion)
+HaveVersion(chanTypePtr, minimumVersion)
+    Tcl_ChannelType *chanTypePtr;
+    Tcl_ChannelTypeVersion minimumVersion;
 {
     Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
 
-    return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));
+    return ((int)actualVersion) >= ((int)minimumVersion);
 }
 
 /*
@@ -10515,19 +9138,17 @@ HaveVersion(
  *---------------------------------------------------------------------- */
 
 Tcl_DriverBlockModeProc *
-Tcl_ChannelBlockModeProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelBlockModeProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->blockModeProc;
+    } else {
+	/*
+	 * The v1 structure had the blockModeProc in a different place.
+	 */
+	return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
     }
-
-    /*
-     * The v1 structure had the blockModeProc in a different place.
-     */
-
-    return (Tcl_DriverBlockModeProc *) chanTypePtr->version;
 }
 
 /*
@@ -10547,9 +9168,8 @@ Tcl_ChannelBlockModeProc(
  */
 
 Tcl_DriverCloseProc *
-Tcl_ChannelCloseProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelCloseProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->closeProc;
 }
@@ -10571,9 +9191,8 @@ Tcl_ChannelCloseProc(
  */
 
 Tcl_DriverClose2Proc *
-Tcl_ChannelClose2Proc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelClose2Proc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->close2Proc;
 }
@@ -10595,9 +9214,8 @@ Tcl_ChannelClose2Proc(
  */
 
 Tcl_DriverInputProc *
-Tcl_ChannelInputProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelInputProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->inputProc;
 }
@@ -10619,9 +9237,8 @@ Tcl_ChannelInputProc(
  */
 
 Tcl_DriverOutputProc *
-Tcl_ChannelOutputProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelOutputProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->outputProc;
 }
@@ -10643,9 +9260,8 @@ Tcl_ChannelOutputProc(
  */
 
 Tcl_DriverSeekProc *
-Tcl_ChannelSeekProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelSeekProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->seekProc;
 }
@@ -10667,9 +9283,8 @@ Tcl_ChannelSeekProc(
  */
 
 Tcl_DriverSetOptionProc *
-Tcl_ChannelSetOptionProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelSetOptionProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->setOptionProc;
 }
@@ -10691,9 +9306,8 @@ Tcl_ChannelSetOptionProc(
  */
 
 Tcl_DriverGetOptionProc *
-Tcl_ChannelGetOptionProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelGetOptionProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->getOptionProc;
 }
@@ -10715,9 +9329,8 @@ Tcl_ChannelGetOptionProc(
  */
 
 Tcl_DriverWatchProc *
-Tcl_ChannelWatchProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelWatchProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->watchProc;
 }
@@ -10739,9 +9352,8 @@ Tcl_ChannelWatchProc(
  */
 
 Tcl_DriverGetHandleProc *
-Tcl_ChannelGetHandleProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelGetHandleProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     return chanTypePtr->getHandleProc;
 }
@@ -10763,14 +9375,14 @@ Tcl_ChannelGetHandleProc(
  */
 
 Tcl_DriverFlushProc *
-Tcl_ChannelFlushProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelFlushProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->flushProc;
+    } else {
+	return NULL;
     }
-    return NULL;
 }
 
 /*
@@ -10790,14 +9402,14 @@ Tcl_ChannelFlushProc(
  */
 
 Tcl_DriverHandlerProc *
-Tcl_ChannelHandlerProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelHandlerProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
 	return chanTypePtr->handlerProc;
+    } else {
+	return NULL;
     }
-    return NULL;
 }
 
 /*
@@ -10817,14 +9429,14 @@ Tcl_ChannelHandlerProc(
  */
 
 Tcl_DriverWideSeekProc *
-Tcl_ChannelWideSeekProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelWideSeekProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
 	return chanTypePtr->wideSeekProc;
+    } else {
+	return NULL;
     }
-    return NULL;
 }
 
 /*
@@ -10832,8 +9444,7 @@ Tcl_ChannelWideSeekProc(
  *
  * Tcl_ChannelThreadActionProc --
  *
- *	TIP #218, Channel Thread Actions. Return the
- *	Tcl_DriverThreadActionProc of the channel type.
+ *	Return the Tcl_DriverThreadActionProc of the channel type.
  *
  * Results:
  *	A pointer to the proc.
@@ -10845,552 +9456,52 @@ Tcl_ChannelWideSeekProc(
  */
 
 Tcl_DriverThreadActionProc *
-Tcl_ChannelThreadActionProc(
-    const Tcl_ChannelType *chanTypePtr)
-				/* Pointer to channel type. */
+Tcl_ChannelThreadActionProc(chanTypePtr)
+    Tcl_ChannelType *chanTypePtr;	/* Pointer to channel type. */
 {
     if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
 	return chanTypePtr->threadActionProc;
-    }
-    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: 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 = 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(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;
-    }
-    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(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 (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
-	    ResetFlag(statePtr, CHANNEL_TAINTED);
-	    Tcl_Release(statePtr);
-	    UpdateStringOfChannel(objPtr);
-	    objPtr->typePtr = NULL;
-	} else if (interpPtr != (Interp*) interp) {
-	    Tcl_Release(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(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 = ckalloc(len + 1);
-	    objPtr->length = len;
-	    memcpy(objPtr->bytes, name, len);
-	} else {
-	    objPtr->bytes = tclEmptyStringRep;
-	    objPtr->length = 0;
-	}
+    } else {
+	return NULL;
     }
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * 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(GET_CHANNELSTATE(objPtr));
-    objPtr->typePtr = NULL;
-}
-
 #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(
-    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);
+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++;
 #ifdef TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING
-    ChanFlag('T', CHANNEL_TIMER_FEV);
-    ChanFlag('H', CHANNEL_HAS_MORE_DATA);
+  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++;
 #endif /* TCL_IO_TRACK_OS_FOR_DRIVER_WITH_BAD_BLOCKING */
-    ChanFlag('x', CHANNEL_INCLOSE);
-
-    buf[i] ='\0';
+  if (flags & CHANNEL_INCLOSE)        {buf[i] = 'x';} else {buf [i]='_';}; i++;
+  buf [i] ='\0';
 
-    fprintf(stderr, "%s: %s\n", str, buf);
-    return 0;
+  fprintf (stderr,"%s: %s\n", str, buf); fflush(stderr);
+  return 0;
 }
 #endif
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
- * End:
- */
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 3283c3e..e9f6151 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.
  */
 
@@ -40,8 +40,8 @@ typedef struct CopyState {
     struct Channel *writePtr;	/* Pointer to output channel. */
     int readFlags;		/* Original read channel flags. */
     int writeFlags;		/* Original write channel flags. */
-    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
-    Tcl_WideInt total;		/* Total bytes transferred (written). */
+    int toRead;			/* Number of bytes to copy, or -1. */
+    int 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[1];		/* Placeholder for real buffer. The real
-				 * buffer occuppies this space + bufSize-1
-				 * bytes. This must be the last field in the
-				 * structure. */
+    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. */
 } ChannelBuffer;
 
-#define CHANNELBUFFER_HEADER_SIZE	TclOffset(ChannelBuffer, buf)
+#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,29 +86,28 @@ 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
@@ -120,28 +119,29 @@ 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. */
-    const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
+
+    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,52 +149,54 @@ 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. */
+    CONST char *channelName;	/* The name of the channel instance in Tcl
+				 * 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
@@ -203,46 +205,37 @@ 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. */
-
-    /*
-     * 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'. */
+    Tcl_ThreadId managingThread; /* TIP #10: Id of the thread managing
+				  * this stack of channels. */
 } 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
@@ -250,109 +243,107 @@ 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_TAINTED		(1<<20)	/* Channel stack structure has changed.
-					 * Used by Channel Tcl_Obj type to
-					 * determine if we have to revalidate
-					 * the channel. */
-#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
-					 * No further Tcl-level write IO on
-					 * the channel is allowed. */
+#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.
+					 */
 
 /*
  * 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. */
@@ -375,17 +366,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 {
@@ -395,26 +386,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
@@ -423,11 +414,3 @@ 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 59856d0..2b3a5a8 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -1,95 +1,47 @@
-/*
+/* 
  * 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.
  */
 
 typedef struct AcceptCallback {
-    char *script;		/* Script to invoke. */
-    Tcl_Interp *interp;		/* Interpreter in which to run it. */
+    char *script;			/* Script to invoke. */
+    Tcl_Interp *interp;			/* Interpreter in which to run it. */
 } 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		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;
-}
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_PutsObjCmd --
  *
- *	This function is invoked to process the "puts" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "puts" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -102,108 +54,94 @@ FinalizeIOCmdTSD(
 
 	/* ARGSUSED */
 int
-Tcl_PutsObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_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;
+    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. */
 
     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(TclGetString(objv[1]), "-nonewline") == 0) {
+    case 3: /* puts -nonewline $x  or  puts $chan $x */ 
+	if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
 	    newline = 0;
+	    channelId = "stdout";
 	} else {
 	    newline = 1;
-	    chanObjPtr = objv[1];
+	    channelId = Tcl_GetString(objv[1]);
 	}
 	string = objv[2];
 	break;
 
-    case 4:			/* [puts -nonewline $chan $x] or
-				 * [puts $chan $x nonewline] */
-	newline = 0;
-	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
-	    chanObjPtr = objv[2];
+    case 4: /* puts -nonewline $chan $x  or  puts $chan $x nonewline */
+	if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
+	    channelId = Tcl_GetString(objv[2]);
 	    string = objv[3];
-	    break;
-#if TCL_MAJOR_VERSION < 9
-	} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
+	} else {
 	    /*
-	     * 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.
+	     * The code below provides backwards compatibility with an
+	     * old form of the command that is no longer recommended
+	     * or documented.
 	     */
 
-	    chanObjPtr = objv[1];
+	    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]);
 	    string = objv[2];
-	    break;
-#endif
 	}
-	/* Fall through */
-    default:			/* [puts] or
-				 * [puts some bad number of arguments...] */
+	newline = 0;
+	break;
+
+    default: /* puts  or  puts some bad number of arguments... */
 	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
 	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;
+    chan = Tcl_GetChannel(interp, channelId, &mode);
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
     }
     if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for writing", NULL);
-	return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", channelId,
+                "\" wasn't opened for writing", (char *) 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;
 
-    /*
-     * 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);
-    }
+    error:
+    Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
+	    Tcl_PosixError(interp), (char *) NULL);
     return TCL_ERROR;
 }
 
@@ -212,8 +150,8 @@ Tcl_PutsObjCmd(
  *
  * Tcl_FlushObjCmd --
  *
- *	This function is called to process the Tcl "flush" command. See the
- *	user documentation for details on what it does.
+ *	This procedure is called to process the Tcl "flush" command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -226,43 +164,34 @@ Tcl_PutsObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_FlushObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *chanObjPtr;
-    Tcl_Channel chan;		/* The channel to flush on. */
+    Tcl_Channel chan;			/* The channel to flush on. */
+    char *channelId;
     int mode;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
 	return TCL_ERROR;
     }
-    chanObjPtr = objv[1];
-    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
+    channelId = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, channelId, &mode);
+    if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for writing", NULL);
-	return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", channelId,
+		"\" wasn't opened for writing", (char *) NULL);
+        return TCL_ERROR;
     }
-
+    
     if (Tcl_Flush(chan) != TCL_OK) {
-	/*
-	 * 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);
-	}
+	Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -273,8 +202,8 @@ Tcl_FlushObjCmd(
  *
  * Tcl_GetsObjCmd --
  *
- *	This function is called to process the Tcl "gets" command. See the
- *	user documentation for details on what it does.
+ *	This procedure is called to process the Tcl "gets" command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -287,60 +216,54 @@ Tcl_FlushObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_GetsObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_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;
+    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;
 
     if ((objc != 2) && (objc != 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
 	return TCL_ERROR;
     }
-    chanObjPtr = objv[1];
-    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
+    name = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, name, &mode);
+    if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for reading", NULL);
-	return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", name,
+		"\" wasn't opened for reading", (char *) 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);
-
-	    /*
-	     * 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;
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
+            return TCL_ERROR;
+        }
+        lineLen = -1;
     }
     if (objc == 3) {
 	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
 		TCL_LEAVE_ERR_MSG) == NULL) {
-	    return TCL_ERROR;
-	}
+	    Tcl_DecrRefCount(linePtr);
+            return TCL_ERROR;
+        }
 	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
+        return TCL_OK;
     } else {
 	Tcl_SetObjResult(interp, linePtr);
     }
@@ -352,8 +275,8 @@ Tcl_GetsObjCmd(
  *
  * Tcl_ReadObjCmd --
  *
- *	This function is invoked to process the Tcl "read" command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the Tcl "read" command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -366,118 +289,94 @@ Tcl_GetsObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_ReadObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_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. */
-    Tcl_Obj *resultPtr, *chanObjPtr;
+    char *name;
+    Tcl_Obj *resultPtr;
 
     if ((objc != 2) && (objc != 3)) {
-	Interp *iPtr;
-
-    argerror:
-	iPtr = (Interp *) interp;
+	argerror:
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?");
-
-	/*
-	 * 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");
+	Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]),
+		" ?-nonewline? channelId\"", (char *) NULL);
 	return TCL_ERROR;
     }
 
     i = 1;
     newline = 0;
-    if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
+    if (strcmp(Tcl_GetString(objv[1]), "-nonewline") == 0) {
 	newline = 1;
 	i++;
     }
 
     if (i == objc) {
-	goto argerror;
+        goto argerror;
     }
 
-    chanObjPtr = objv[i];
-    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
+    name = Tcl_GetString(objv[i]);
+    chan = Tcl_GetChannel(interp, name, &mode);
+    if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
-		"\" wasn't opened for reading", NULL);
-	return TCL_ERROR;
+	Tcl_AppendResult(interp, "channel \"", name, 
+                "\" wasn't opened for reading", (char *) NULL);
+        return TCL_ERROR;
     }
-    i++;			/* Consumed channel name. */
+    i++;	/* Consumed channel name. */
 
     /*
-     * Compute how many bytes to read.
+     * Compute how many bytes to read, and see whether the final
+     * newline should be dropped.
      */
 
     toRead = -1;
     if (i < objc) {
-	if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
-		|| (toRead < 0)) {
-#if TCL_MAJOR_VERSION < 9
-	    /*
-	     * 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) {
-#endif
-	    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;
-#if TCL_MAJOR_VERSION < 9
+	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;
 	    }
+	} else if (strcmp(arg, "nonewline") == 0) {
 	    newline = 1;
-#endif
-	}
+	} else {
+	    Tcl_AppendResult(interp, "bad argument \"", arg,
+		    "\": should be \"nonewline\"", (char *) NULL);
+	    return TCL_ERROR;
+        }
     }
 
     resultPtr = Tcl_NewObj();
     Tcl_IncrRefCount(resultPtr);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead < 0) {
-	/*
-	 * 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_ResetResult(interp);
+	Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+		Tcl_PosixError(interp), (char *) NULL);
 	Tcl_DecrRefCount(resultPtr);
 	return TCL_ERROR;
     }
-
+    
     /*
      * If requested, remove the last newline in the channel if at EOF.
      */
-
+    
     if ((charactersRead > 0) && (newline != 0)) {
-	const char *result;
+	char *result;
 	int length;
 
-	result = TclGetStringFromObj(resultPtr, &length);
+	result = Tcl_GetStringFromObj(resultPtr, &length);
 	if (result[length - 1] == '\n') {
 	    Tcl_SetObjLength(resultPtr, length - 1);
 	}
@@ -492,42 +391,45 @@ Tcl_ReadObjCmd(
  *
  * Tcl_SeekObjCmd --
  *
- *	This function is invoked to process the Tcl "seek" command. See the
- *	user documentation for details on what it does.
+ *	This procedure 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 clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_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. */
+    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;
     int optionIndex;
-    static const char *const originOptions[] = {
-	"start", "current", "end", NULL
+    static CONST char *originOptions[] = {
+	"start", "current", "end", (char *) NULL
     };
-    static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
+    static CONST int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
 
     if ((objc != 3) && (objc != 4)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
 	return TCL_ERROR;
     }
-    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
+    chanName = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, chanName, NULL);
+    if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
     if (Tcl_GetWideIntFromObj(interp, objv[2], &offset) != TCL_OK) {
@@ -544,19 +446,9 @@ Tcl_SeekObjCmd(
 
     result = Tcl_Seek(chan, offset, mode);
     if (result == Tcl_LongAsWide(-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_AppendResult(interp, "error during seek on \"",
-		    TclGetString(objv[1]), "\": ", Tcl_PosixError(interp),
-		    NULL);
-	}
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "error during seek on \"", 
+		chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+        return TCL_ERROR;
     }
     return TCL_OK;
 }
@@ -566,8 +458,8 @@ Tcl_SeekObjCmd(
  *
  * Tcl_TellObjCmd --
  *
- *	This function is invoked to process the Tcl "tell" command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the Tcl "tell" command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -580,42 +472,30 @@ Tcl_SeekObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_TellObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Channel chan;		/* The channel to tell on. */
-    Tcl_WideInt newLoc;
+    Tcl_Channel chan;			/* The channel to tell on. */
+    char *chanName;
 
     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);
-
     /*
-     * TIP #219.
-     * Capture error messages put by the driver into the bypass area and put
-     * them into the regular interpreter result.
+     * Try to find a channel with the right name and permissions in
+     * the IO channel table of this interpreter.
      */
-
-    if (TclChanCaughtErrorBypass(interp, chan)) {
+    
+    chanName = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, chanName, NULL);
+    if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
-
-    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(newLoc));
+    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), Tcl_Tell(chan));
     return TCL_OK;
 }
 
@@ -624,8 +504,8 @@ Tcl_TellObjCmd(
  *
  * Tcl_CloseObjCmd --
  *
- *	This function is invoked to process the Tcl "close" command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the Tcl "close" command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -638,91 +518,48 @@ Tcl_TellObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_CloseObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Channel chan;		/* The channel to close. */
-    static const char *const dirOptions[] = {
-	"read", "write", NULL
-    };
-    static const int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
+    Tcl_Channel chan;			/* The channel to close. */
+    char *arg;
 
-    if ((objc != 2) && (objc != 3)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
 	return TCL_ERROR;
     }
 
-    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
+    arg = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, arg, NULL);
+    if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
 
-    if (objc == 3) {
-	int index, dir;
-
-	/*
-	 * Get direction requested to close, and check syntax.
-	 */
-
-	if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
-		&index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	dir = dirArray[index];
-
-	/*
-	 * Check direction against channel mode. It is an error if we try to
-	 * close a direction not supported by the channel (already closed, or
-	 * never opened for that direction).
-	 */
-
-	if (!(dir & Tcl_GetChannelMode(chan))) {
-	    Tcl_AppendResult(interp, "Half-close of ", dirOptions[index],
-		    "-side not possible, side not opened or already closed",
-		    NULL);
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Special handling is needed if and only if the channel mode supports
-	 * more than the direction to close. Because if the close the last
-	 * direction suppported we can and will go through the regular
-	 * process.
-	 */
-
-	if ((Tcl_GetChannelMode(chan) &
-		(TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) {
-	    return Tcl_CloseEx(interp, chan, dir);
-	}
-    }
-
     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 = Tcl_GetObjResult(interp);
-	const char *string;
+        /*
+         * 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;
+	char *string;
 	int len;
-
-	if (Tcl_IsShared(resultPtr)) {
-	    resultPtr = Tcl_DuplicateObj(resultPtr);
-	    Tcl_SetObjResult(interp, resultPtr);
-	}
-	string = TclGetStringFromObj(resultPtr, &len);
-	if ((len > 0) && (string[len - 1] == '\n')) {
+	
+	resultPtr = Tcl_GetObjResult(interp);
+	string = Tcl_GetStringFromObj(resultPtr, &len);
+        if ((len > 0) && (string[len - 1] == '\n')) {
 	    Tcl_SetObjLength(resultPtr, len - 1);
-	}
-	return TCL_ERROR;
+        }
+        return TCL_ERROR;
     }
 
     return TCL_OK;
@@ -733,8 +570,8 @@ Tcl_CloseObjCmd(
  *
  * Tcl_FconfigureObjCmd --
  *
- *	This function is invoked to process the Tcl "fconfigure" command. See
- *	the user documentation for details on what it does.
+ *	This procedure is invoked to process the Tcl "fconfigure" command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -747,59 +584,55 @@ Tcl_CloseObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_FconfigureObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *optionName, *valueName;
-    Tcl_Channel chan;		/* The channel to set a mode on. */
-    int i;			/* Iterate over arg-value pairs. */
+    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. */
 
     if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
-	return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"channelId ?optionName? ?value? ?optionName value?...");
+        return TCL_ERROR;
     }
-
-    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
-	return TCL_ERROR;
+    chanName = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, chanName, NULL);
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
     }
-
     if (objc == 2) {
-	Tcl_DString ds;		/* DString to hold result of calling
-				 * Tcl_GetChannelOption. */
-
-	Tcl_DStringInit(&ds);
-	if (Tcl_GetChannelOption(interp, chan, NULL, &ds) != TCL_OK) {
+        Tcl_DStringInit(&ds);
+        if (Tcl_GetChannelOption(interp, chan, (char *) NULL, &ds) != TCL_OK) {
 	    Tcl_DStringFree(&ds);
 	    return TCL_ERROR;
-	}
-	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;
+        }
+        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;
     }
-
     for (i = 3; i < objc; i += 2) {
-	optionName = TclGetString(objv[i-1]);
-	valueName = TclGetString(objv[i]);
-	if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
+	optionName = Tcl_GetString(objv[i-1]);
+	valueName = Tcl_GetString(objv[i]);
+        if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
 		!= TCL_OK) {
-	    return TCL_ERROR;
-	}
+            return TCL_ERROR;
+        }
     }
-
     return TCL_OK;
 }
 
@@ -808,39 +641,43 @@ Tcl_FconfigureObjCmd(
  *
  * Tcl_EofObjCmd --
  *
- *	This function is invoked to process the Tcl "eof" command. See the
- *	user documentation for details on what it does.
+ *	This procedure 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(
-    ClientData unused,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Channel chan;
+    int dummy;
+    char *arg;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
 
-    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
+    arg = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, arg, &dummy);
+    if (chan == NULL) {
 	return TCL_ERROR;
     }
 
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_Eof(chan)));
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_Eof(chan));
     return TCL_OK;
 }
 
@@ -849,8 +686,8 @@ Tcl_EofObjCmd(
  *
  * Tcl_ExecObjCmd --
  *
- *	This function is invoked to process the "exec" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "exec" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -863,34 +700,47 @@ Tcl_EofObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_ExecObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
+#ifdef MAC_TCL
+
+    Tcl_AppendResult(interp, "exec not implemented under Mac OS",
+		(char *)NULL);
+    return TCL_ERROR;
+
+#else /* !MAC_TCL */
+
+    /*
+     * 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
     Tcl_Obj *resultPtr;
-    const char **argv;		/* An array for the string arguments. Stored
-				 * on the _Tcl_ stack. */
-    const char *string;
+    CONST char **argv;
+    char *string;
     Tcl_Channel chan;
+    CONST char *argStorage[NUM_ARGS];
     int argc, background, i, index, keepNewline, result, skip, length;
-    int ignoreStderr;
-    static const char *const options[] = {
-	"-ignorestderr", "-keepnewline", "--", NULL
+    static CONST char *options[] = {
+	"-keepnewline",	"--",		NULL
     };
     enum options {
-	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
+	EXEC_KEEPNEWLINE, EXEC_LAST
     };
 
     /*
-     * Check for any leading option arguments.
+     * Check for a leading "-keepnewline" argument.
      */
 
     keepNewline = 0;
-    ignoreStderr = 0;
     for (skip = 1; skip < objc; skip++) {
-	string = TclGetString(objv[skip]);
+	string = Tcl_GetString(objv[skip]);
 	if (string[0] != '-') {
 	    break;
 	}
@@ -900,15 +750,13 @@ Tcl_ExecObjCmd(
 	}
 	if (index == EXEC_KEEPNEWLINE) {
 	    keepNewline = 1;
-	} else if (index == EXEC_IGNORESTDERR) {
-	    ignoreStderr = 1;
 	} else {
 	    skip++;
 	    break;
 	}
     }
     if (objc <= skip) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-switch ...? arg ?arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?");
 	return TCL_ERROR;
     }
 
@@ -917,19 +765,23 @@ Tcl_ExecObjCmd(
      */
 
     background = 0;
-    string = TclGetString(objv[objc - 1]);
+    string = Tcl_GetString(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;
-    argv = TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));
+    if ((argc + 1) > (int)(sizeof(argv) / sizeof(argv[0]))) {
+	argv = (CONST char **) ckalloc((unsigned)(argc + 1) * sizeof(char *));
+    }
 
     /*
      * Copy the string conversions of each (post option) object into the
@@ -937,71 +789,64 @@ Tcl_ExecObjCmd(
      */
 
     for (i = 0; i < argc; i++) {
-	argv[i] = TclGetString(objv[i + skip]);
+	argv[i] = Tcl_GetString(objv[i + skip]);
     }
     argv[argc] = NULL;
-    chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
-	    ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));
+    chan = Tcl_OpenCommandChannel(interp, argc, argv,
+            (background ? 0 : TCL_STDOUT | TCL_STDERR));
 
     /*
-     * Free the argv array.
+     * Free the argv array if malloc'ed storage was used.
      */
 
-    TclStackFree(interp, (void *) argv);
+    if (argv != argStorage) {
+	ckfree((char *)argv);
+    }
 
-    if (chan == NULL) {
+    if (chan == (Tcl_Channel) 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) {
-	    /*
-	     * 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);
-	    }
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "error reading output from command: ",
+		    Tcl_PosixError(interp), (char *) 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);
-    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
+    string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+    Tcl_AppendToObj(resultPtr, string, length);
 
     /*
-     * 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 = TclGetStringFromObj(resultPtr, &length);
+	string = Tcl_GetStringFromObj(resultPtr, &length);
 	if ((length > 0) && (string[length - 1] == '\n')) {
 	    Tcl_SetObjLength(resultPtr, length - 1);
 	}
@@ -1009,6 +854,7 @@ Tcl_ExecObjCmd(
     Tcl_SetObjResult(interp, resultPtr);
 
     return result;
+#endif /* !MAC_TCL */
 }
 
 /*
@@ -1016,45 +862,48 @@ Tcl_ExecObjCmd(
  *
  * Tcl_FblockedObjCmd --
  *
- *	This function is invoked to process the Tcl "fblocked" command. See
- *	the user documentation for details on what it does.
+ *	This procedure 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(
-    ClientData unused,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Channel chan;
     int mode;
+    char *arg;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
 
-    if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
-	return TCL_ERROR;
+    arg = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, arg, &mode);
+    if (chan == NULL) {
+        return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
-		"\" wasn't opened for reading", NULL);
-	return TCL_ERROR;
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+		arg, "\" wasn't opened for reading", (char *) NULL);
+        return TCL_ERROR;
     }
-
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_InputBlocked(chan)));
+        
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), Tcl_InputBlocked(chan));
     return TCL_OK;
 }
 
@@ -1063,8 +912,8 @@ Tcl_FblockedObjCmd(
  *
  * Tcl_OpenObjCmd --
  *
- *	This function is invoked to process the "open" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "open" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1077,14 +926,14 @@ Tcl_FblockedObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_OpenObjCmd(
-    ClientData notUsed,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int pipeline, prot;
-    const char *modeString, *what;
+    char *modeString, *what;
     Tcl_Channel chan;
 
     if ((objc < 2) || (objc > 4)) {
@@ -1095,36 +944,16 @@ Tcl_OpenObjCmd(
     if (objc == 2) {
 	modeString = "r";
     } else {
-	modeString = TclGetString(objv[2]);
+	modeString = Tcl_GetString(objv[2]);
 	if (objc == 4) {
-	    const 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) {
+	    if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	}
     }
 
     pipeline = 0;
-    what = TclGetString(objv[1]);
+    what = Tcl_GetString(objv[1]);
     if (what[0] == '|') {
 	pipeline = 1;
     }
@@ -1134,47 +963,50 @@ Tcl_OpenObjCmd(
      */
 
     if (!pipeline) {
-	chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
+        chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
     } else {
-	int mode, seekFlag, cmdObjc, binary;
-	const char **cmdArgv;
+#ifdef MAC_TCL
+	Tcl_AppendResult(interp,
+		"command pipelines not supported on Macintosh OS",
+		(char *)NULL);
+	return TCL_ERROR;
+#else
+	int mode, seekFlag, cmdObjc;
+	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 = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
-	if (mode == -1) {
+        mode = TclGetOpenMode(interp, modeString, &seekFlag);
+        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:
-		Tcl_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:
+		    panic("Tcl_OpenCmd: invalid mode value");
+		    break;
 	    }
 	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
-	    if (binary && chan) {
-		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
-	    }
 	}
-	ckfree(cmdArgv);
+        ckfree((char *) cmdArgv);
+#endif
     }
-    if (chan == NULL) {
-	return TCL_ERROR;
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
     }
     Tcl_RegisterChannel(interp, chan);
-    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
+    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
     return TCL_OK;
 }
 
@@ -1183,41 +1015,43 @@ Tcl_OpenObjCmd(
  *
  * 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 clientData,	/* Data which was passed when the assocdata
-				 * was registered. */
-    Tcl_Interp *interp)		/* Interpreter being deleted - not used. */
+TcpAcceptCallbacksDeleteProc(clientData, interp)
+    ClientData clientData;	/* Data which was passed when the assocdata
+                                 * was registered. */
+    Tcl_Interp *interp;		/* Interpreter being deleted - not used. */
 {
-    Tcl_HashTable *hTblPtr = clientData;
+    Tcl_HashTable *hTblPtr;
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch hSearch;
+    AcceptCallback *acceptCallbackPtr;
 
+    hTblPtr = (Tcl_HashTable *) clientData;
     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
-	AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);
-
-	acceptCallbackPtr->interp = NULL;
+             hPtr != (Tcl_HashEntry *) NULL;
+             hPtr = Tcl_NextHashEntry(&hSearch)) {
+        acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
+        acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
     }
     Tcl_DeleteHashTable(hTblPtr);
-    ckfree(hTblPtr);
+    ckfree((char *) hTblPtr);
 }
 
 /*
@@ -1225,49 +1059,50 @@ TcpAcceptCallbacksDeleteProc(
  *
  * 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(
-    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(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. */
 {
-    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 isNew;			/* Is the entry new? */
-
-    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
-
-    if (hTblPtr == NULL) {
-	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
-	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
-		TcpAcceptCallbacksDeleteProc, hTblPtr);
-    }
-
-    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
-    if (!isNew) {
-	Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
-    }
-    Tcl_SetHashValue(hPtr, acceptCallbackPtr);
+    int new;			/* 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);
 }
 
 /*
@@ -1275,40 +1110,41 @@ RegisterTcpServerInterpCleanup(
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter in which the accept callback
-				 * record was registered. */
-    AcceptCallback *acceptCallbackPtr)
-				/* The record for which to delete the
-				 * registration. */
+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. */
 {
     Tcl_HashTable *hTblPtr;
     Tcl_HashEntry *hPtr;
 
-    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
-    if (hTblPtr == NULL) {
-	return;
+    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
+            "tclTCPAcceptCallbacks", NULL);
+    if (hTblPtr == (Tcl_HashTable *) NULL) {
+        return;
     }
-
     hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
-    if (hPtr != NULL) {
-	Tcl_DeleteHashEntry(hPtr);
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        return;
     }
+    Tcl_DeleteHashEntry(hPtr);
 }
 
 /*
@@ -1316,8 +1152,8 @@ UnregisterTcpServerInterpCleanupProc(
  *
  * 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.
@@ -1329,65 +1165,72 @@ UnregisterTcpServerInterpCleanupProc(
  */
 
 static void
-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. */
+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. */
 {
-    AcceptCallback *acceptCallbackPtr = callbackData;
+    AcceptCallback *acceptCallbackPtr;
+    Tcl_Interp *interp;
+    char *script;
+    char portBuf[TCL_INTEGER_SPACE];
+    int result;
+
+    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) {
 
-    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);
+        script = acceptCallbackPtr->script;
+        interp = acceptCallbackPtr->interp;
+        
+        Tcl_Preserve((ClientData) script);
+        Tcl_Preserve((ClientData) 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(NULL, chan);
-
-	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
-		" ", address, " ", portBuf, NULL);
-	if (result != TCL_OK) {
-	    Tcl_BackgroundException(interp, result);
+        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_UnregisterChannel(interp, chan);
-	}
-
-	/*
-	 * Decrement the artificially bumped refcount. After this it is not
-	 * safe anymore to use "chan", because it may now be deleted.
-	 */
+        }
 
-	Tcl_UnregisterChannel(NULL, chan);
+        /*
+         * Decrement the artificially bumped refcount. After this it is
+         * not safe anymore to use "chan", because it may now be deleted.
+         */
 
-	Tcl_Release(interp);
-	Tcl_Release(script);
+        Tcl_UnregisterChannel((Tcl_Interp *) NULL, chan);
+        
+        Tcl_Release((ClientData) interp);
+        Tcl_Release((ClientData) script);
     } else {
-	/*
-	 * The interpreter has been deleted, so there is no useful way to use
-	 * the client socket - just close it.
-	 */
 
-	Tcl_Close(NULL, chan);
+        /*
+         * 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);
     }
 }
 
@@ -1396,36 +1239,37 @@ AcceptCallbackProc(
  *
  * 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(
-    ClientData callbackData)	/* The data passed in the call to
-				 * Tcl_CreateCloseHandler. */
+TcpServerCloseProc(callbackData)
+    ClientData callbackData;	/* The data passed in the call to
+                                 * Tcl_CreateCloseHandler. */
 {
-    AcceptCallback *acceptCallbackPtr = callbackData;
-				/* The actual data. */
+    AcceptCallback *acceptCallbackPtr;
+    				/* The actual data. */
 
-    if (acceptCallbackPtr->interp != NULL) {
-	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
-		acceptCallbackPtr);
+    acceptCallbackPtr = (AcceptCallback *) callbackData;
+    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
+        UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
+                acceptCallbackPtr);
     }
-    Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
-    ckfree(acceptCallbackPtr);
+    Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
+    ckfree((char *) acceptCallbackPtr);
 }
 
 /*
@@ -1433,8 +1277,8 @@ TcpServerCloseProc(
  *
  * Tcl_SocketObjCmd --
  *
- *	This function is invoked to process the "socket" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "socket" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -1446,114 +1290,127 @@ TcpServerCloseProc(
  */
 
 int
-Tcl_SocketObjCmd(
-    ClientData notUsed,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    static const char *const socketOptions[] = {
-	"-async", "-myaddr", "-myport", "-server", NULL
+    static CONST char *socketOptions[] = {
+	"-async", "-myaddr", "-myport","-server", (char *) NULL
     };
     enum socketOptions {
-	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
+	SKT_ASYNC,      SKT_MYADDR,      SKT_MYPORT,      SKT_SERVER  
     };
-    int optionIndex, a, server = 0, port, myport = 0, async = 0;
-    const char *host, *script = NULL, *myaddr = NULL;
+    int optionIndex, a, server, port;
+    char *arg, *copyScript, *host, *script;
+    char *myaddr = NULL;
+    int myport = 0;
+    int async = 0;
     Tcl_Channel chan;
+    AcceptCallback *acceptCallbackPtr;
+    
+    server = 0;
+    script = NULL;
 
     if (TclpHasSockets(interp) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     for (a = 1; a < objc; a++) {
-	const char *arg = Tcl_GetString(objv[a]);
-
+	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", NULL);
-		return TCL_ERROR;
-	    }
-	    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_ASYNC: {
+                if (server == 1) {
+                    Tcl_AppendResult(interp,
+                            "cannot set -async option for server sockets",
+                            (char *) NULL);
+                    return TCL_ERROR;
+                }
+                async = 1;		
+		break;
 	    }
-	    myaddr = TclGetString(objv[a]);
-	    break;
-	case SKT_MYPORT: {
-	    const char *myPortName;
-
-	    a++;
-	    if (a >= objc) {
-		Tcl_AppendResult(interp,
-			"no argument given for -myport option", 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;
 	    }
-	    myPortName = TclGetString(objv[a]);
-	    if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) {
-		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;
 	    }
-	    break;
-	}
-	case SKT_SERVER:
-	    if (async == 1) {
-		Tcl_AppendResult(interp,
-			"cannot set -async option for server sockets", 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;
 	    }
-	    server = 1;
-	    a++;
-	    if (a >= objc) {
-		Tcl_AppendResult(interp,
-			"no argument given for -server option", NULL);
-		return TCL_ERROR;
+	    default: {
+		panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
 	    }
-	    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 = TclGetString(objv[a]);
+	host = Tcl_GetString(objv[a]);
 	a++;
     } else {
-	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");
-	return TCL_ERROR;
+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;
     }
 
     if (a == objc-1) {
-	if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
-		&port) != TCL_OK) {
+	if (TclSockGetPort(interp, Tcl_GetString(objv[a]),
+		"tcp", &port) != TCL_OK) {
 	    return TCL_ERROR;
 	}
     } else {
@@ -1561,47 +1418,46 @@ Tcl_SocketObjCmd(
     }
 
     if (server) {
-	AcceptCallback *acceptCallbackPtr =
-		ckalloc(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(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);
+        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);
     } else {
-	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);
-
+        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);
+    
     return TCL_OK;
 }
 
@@ -1610,31 +1466,32 @@ Tcl_SocketObjCmd(
  *
  * Tcl_FcopyObjCmd --
  *
- *	This function is invoked to process the "fcopy" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure 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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Channel inChan, outChan;
-    int mode, i, index;
-    Tcl_WideInt toRead;
+    char *arg;
+    int mode, i;
+    int toRead, index;
     Tcl_Obj *cmdPtr;
-    static const char *const switches[] = { "-size", "-command", NULL };
+    static CONST char* switches[] = { "-size", "-command", NULL };
     enum { FcopySize, FcopyCommand };
 
     if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
@@ -1644,357 +1501,60 @@ Tcl_FcopyObjCmd(
     }
 
     /*
-     * 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.
      */
 
-    if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
+    arg = Tcl_GetString(objv[1]);
+    inChan = Tcl_GetChannel(interp, arg, &mode);
+    if (inChan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_READABLE) == 0) {
-	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) {
+	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) {
 	return TCL_ERROR;
     }
     if ((mode & TCL_WRITABLE) == 0) {
-	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]),
-		"\" wasn't opened for writing", NULL);
-	return TCL_ERROR;
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "channel \"",
+		arg, 
+                "\" wasn't opened for writing", (char *) NULL);
+        return TCL_ERROR;
     }
 
     toRead = -1;
     cmdPtr = NULL;
     for (i = 3; i < objc; i += 2) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
-		&index) != TCL_OK) {
+		(int *) &index) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	switch (index) {
-	case FcopySize:
-	    if (Tcl_GetWideIntFromObj(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 (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;
 	}
     }
 
     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 *const 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ChanPipeObjCmd --
- *
- *	This function is invoked to process the "chan pipe" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Creates a pair of Tcl channels wrapping both ends of a new
- *	anonymous pipe.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ChanPipeObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Tcl_Channel rchan, wchan;
-    const char *channelNames[2];
-    Tcl_Obj *resultPtr;
-
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, "");
-	return TCL_ERROR;
-    }
-
-    if (Tcl_CreatePipe(interp, &rchan, &wchan, 0) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    channelNames[0] = Tcl_GetChannelName(rchan);
-    channelNames[1] = Tcl_GetChannelName(wchan);
-
-    resultPtr = Tcl_NewObj();
-    Tcl_ListObjAppendElement(NULL, resultPtr,
-	    Tcl_NewStringObj(channelNames[0], -1));
-    Tcl_ListObjAppendElement(NULL, resultPtr,
-	    Tcl_NewStringObj(channelNames[1], -1));
-    Tcl_SetObjResult(interp, resultPtr);
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclChannelNamesCmd --
- *
- *	This function is invoked to process the "chan names" and "file
- *	channels" Tcl commands.  See the user documentation for details on
- *	what they do.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclChannelNamesCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    if (objc < 1 || objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
-    }
-    return Tcl_GetChannelNamesEx(interp,
-	    ((objc == 1) ? NULL : TclGetString(objv[1])));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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, NULL, NULL, NULL, 0},
-	{"close",	Tcl_CloseObjCmd, NULL, NULL, NULL, 0},
-	{"copy",	Tcl_FcopyObjCmd, NULL, NULL, NULL, 0},
-	{"create",	TclChanCreateObjCmd, NULL, NULL, NULL, 0},		/* TIP #219 */
-	{"eof",		Tcl_EofObjCmd, NULL, NULL, NULL, 0},
-	{"event",	Tcl_FileEventObjCmd, NULL, NULL, NULL, 0},
-	{"flush",	Tcl_FlushObjCmd, NULL, NULL, NULL, 0},
-	{"gets",	Tcl_GetsObjCmd, NULL, NULL, NULL, 0},
-	{"names",	TclChannelNamesCmd, NULL, NULL, NULL, 0},
-	{"pending",	ChanPendingObjCmd, NULL, NULL, NULL, 0},		/* TIP #287 */
-	{"pop",		TclChanPopObjCmd, NULL, NULL, NULL, 0},		/* TIP #230 */
-	{"postevent",	TclChanPostEventObjCmd, NULL, NULL, NULL, 0},	/* TIP #219 */
-	{"push",	TclChanPushObjCmd, NULL, NULL, NULL, 0},		/* TIP #230 */
-	{"puts",	Tcl_PutsObjCmd, NULL, NULL, NULL, 0},
-	{"read",	Tcl_ReadObjCmd, NULL, NULL, NULL, 0},
-	{"seek",	Tcl_SeekObjCmd, NULL, NULL, NULL, 0},
-	{"pipe",	ChanPipeObjCmd, NULL, NULL, NULL, 0},		/* TIP #304 */
-	{"tell",	Tcl_TellObjCmd, NULL, NULL, NULL, 0},
-	{"truncate",	ChanTruncateObjCmd, NULL, NULL, NULL, 0},		/* TIP #208 */
-	{NULL, NULL, NULL, NULL, NULL, 0}
-    };
-    static const char *const extras[] = {
-	"configure",	"::fconfigure",
-	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 6f80c25..8699b39 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -1,101 +1,112 @@
 /*
  * 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(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);
+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));
 
 /*
- * 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(ClientData clientData);
+static void		TransformChannelHandlerTimer _ANSI_ARGS_ ((
+				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(TransformChannelData *ctrl,
-			    Tcl_Interp *interp, unsigned char *op,
-			    unsigned char *buf, int bufLen, int transmit,
-			    int preserve);
+static int		ExecuteCallback _ANSI_ARGS_ ((
+				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'), telling
- * the procedure what to do with the result of the script it calls.
+ * Action codes to give to 'ExecuteCallback' (argument 'transmit')
+ * confering to 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.
@@ -103,75 +114,74 @@ static int		ExecuteCallback(TransformChannelData *ctrl,
 
 typedef struct ResultBuffer ResultBuffer;
 
-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);
+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));
 
 /*
- * This structure describes the channel type structure for Tcl-based
+ * This structure describes the channel type structure for tcl based
  * transformations.
  */
 
-static const Tcl_ChannelType transformChannelType = {
-    "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. */
+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
 };
 
 /*
  * 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. */
-    size_t allocated;		/* Allocated size of the buffer area. */
-    size_t used;		/* Number of bytes in the buffer, no more than
-				 * number allocated. */
+    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 */
 };
 
 /*
- * 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 UCHARP(x) ((unsigned char*) (x))
+#define NO_INTERP ((Tcl_Interp*) NULL)
 
 /*
  * Definition of a structure used by all transformations generated here to
@@ -179,47 +189,48 @@ 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 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. */
-
+    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 */
     /*
      * 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. Also
-				 * 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. Additionally
+			     * 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.
@@ -232,63 +243,69 @@ struct TransformChannelData {
 
 	/* ARGSUSED */
 int
-TclChannelTransform(
-    Tcl_Interp *interp,		/* Interpreter for result. */
-    Tcl_Channel chan,		/* Channel to transform. */
-    Tcl_Obj *cmdObjPtr)		/* Script to use for transform. */
+TclChannelTransform(interp, chan, cmdObjPtr)
+    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;			/* Read/write mode of the channel. */
-    TransformChannelData *dataPtr;
-    Tcl_DString ds;
-
-    if (chan == NULL) {
+    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) {
 	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 = 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 = 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	= (Tcl_TimerToken) 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, dataPtr,
-	    mode, chan);
-    if (dataPtr->self == NULL) {
+    dataPtr->self = Tcl_StackChannel(interp, &transformChannelType,
+	    (ClientData) dataPtr, mode, chan);
+    if (dataPtr->self == (Tcl_Channel) NULL) {
 	Tcl_AppendResult(interp, "\nfailed to stack channel \"",
-		Tcl_GetChannelName(chan), "\"", NULL);
+		Tcl_GetChannelName(chan), "\"", (char *) NULL);
+
 	Tcl_DecrRefCount(dataPtr->command);
 	ResultClear(&dataPtr->result);
-	ckfree(dataPtr);
+	ckfree((VOID *) dataPtr);
 	return TCL_ERROR;
     }
 
@@ -296,62 +313,65 @@ TclChannelTransform(
      * At last initialize the transformation at the script level.
      */
 
-    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_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_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;
+    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;
+	}
     }
 
     return TCL_OK;
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * ExecuteCallback --
+ *	ExecuteCallback --
  *
- *	Executes the defined callback for buffer and operation.
+ *	Executes the defined callback for buffer and
+ *	operation.
  *
- * Side effects:
- *	As of the executed tcl script.
+ *	Sideeffects:
+ *		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(
-    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. */
+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. */
 {
-    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
@@ -360,43 +380,72 @@ ExecuteCallback(
      * arguments. Feather's curried commands would come in handy here.
      */
 
-    if (preserve == P_PRESERVE) {
-	state = Tcl_SaveInterpState(dataPtr->interp, res);
+    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;
     }
 
     Tcl_IncrRefCount(command);
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewStringObj((char *) op, -1));
-    if (res != TCL_OK) {
-	goto cleanup;
+
+    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)
+	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.
      */
 
-    res = Tcl_ListObjAppendElement(dataPtr->interp, command,
-	    Tcl_NewByteArrayObj(buf, bufLen));
-    if (res != TCL_OK) {
-	goto cleanup;
+    temp = Tcl_NewByteArrayObj(buf, bufLen);
+
+    if (temp == (Tcl_Obj*) NULL) {
+        /* Memory allocation problem */
+	res = TCL_ERROR;
+        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 = NULL;
+    Tcl_DecrRefCount (command);
+    command = (Tcl_Obj*) NULL;
 
-    if ((res != TCL_OK) && (interp != NULL) && (dataPtr->interp != interp)
-	    && (preserve == P_NO_PRESERVE)) {
-	Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
+    if ((res != TCL_OK) && (interp != NO_INTERP) &&
+	    (dataPtr->interp != interp) && !preserve) {
+        Tcl_SetObjResult(interp, Tcl_GetObjResult(dataPtr->interp));
 	return res;
     }
 
@@ -406,115 +455,121 @@ ExecuteCallback(
      */
 
     switch (transmit) {
-    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;
+	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;
     }
 
     Tcl_ResetResult(dataPtr->interp);
-    if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
+
+    if (preserve) {
+	Tcl_RestoreResult(dataPtr->interp, &ciSave);
     }
+
     return res;
 
-  cleanup:
-    if (preserve == P_PRESERVE) {
-	(void) Tcl_RestoreInterpState(dataPtr->interp, state);
+    cleanup:
+    if (preserve) {
+	Tcl_RestoreResult(dataPtr->interp, &ciSave);
     }
-    if (command != NULL) {
-	Tcl_DecrRefCount(command);
+
+    if (command != (Tcl_Obj*) 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.
  *
- * Side effects:
- *	Forwards the request to the underlying channel.
+ *	Sideeffects:
+ *		Forwards the request to the underlying
+ *		channel.
  *
- * Result:
- *	0 if successful, errno when failed.
+ *	Result:
+ *		0 if successful, errno when failed.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static int
-TransformBlockModeProc(
-    ClientData instanceData,	/* State of transformation. */
-    int mode)			/* New blocking mode. */
+TransformBlockModeProc (instanceData, mode)
+    ClientData  instanceData; /* State of transformation */
+    int         mode;         /* New blocking mode */
 {
-    TransformChannelData *dataPtr = instanceData;
+    TransformChannelData* dataPtr = (TransformChannelData*) 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.
  *
- * Side effects:
- *	Releases the memory allocated in 'Tcl_TransformObjCmd'.
+ *	Sideeffects:
+ *		Releases the memory allocated in
+ *		'Tcl_TransformObjCmd'.
  *
- * Result:
- *	None.
+ *	Result:
+ *		None.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static int
-TransformCloseProc(
-    ClientData instanceData,
-    Tcl_Interp *interp)
+TransformCloseProc (instanceData, interp)
+    ClientData  instanceData;
+    Tcl_Interp* interp;
 {
-    TransformChannelData *dataPtr = instanceData;
+    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+
+    /*
+     * Important: In this procedure 'dataPtr->self' already points to
+     * the underlying channel.
+     */
 
     /*
-     * 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'.
@@ -523,82 +578,81 @@ TransformCloseProc(
      * removed channel.
      */
 
-    if (dataPtr->timer != NULL) {
-	Tcl_DeleteTimerHandler(dataPtr->timer);
-	dataPtr->timer = NULL;
+    if (dataPtr->timer != (Tcl_TimerToken) NULL) {
+        Tcl_DeleteTimerHandler (dataPtr->timer);
+	dataPtr->timer = (Tcl_TimerToken) 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, P_PRESERVE);
+        ExecuteCallback (dataPtr, interp, A_FLUSH_WRITE,
+		NULL, 0, TRANSMIT_DOWN, 1);
     }
 
     if ((dataPtr->mode & TCL_READABLE) && !dataPtr->readIsFlushed) {
 	dataPtr->readIsFlushed = 1;
-	ExecuteCallback(dataPtr, interp, A_FLUSH_READ, NULL, 0, TRANSMIT_IBUF,
-		P_PRESERVE);
+        ExecuteCallback (dataPtr, interp, A_FLUSH_READ,
+		NULL, 0, TRANSMIT_IBUF, 1);
     }
 
     if (dataPtr->mode & TCL_WRITABLE) {
-	ExecuteCallback(dataPtr, interp, A_DELETE_WRITE, NULL, 0,
-		TRANSMIT_DONT, P_PRESERVE);
+        ExecuteCallback (dataPtr, interp, A_DELETE_WRITE,
+		NULL, 0, TRANSMIT_DONT, 1);
     }
+
     if (dataPtr->mode & TCL_READABLE) {
-	ExecuteCallback(dataPtr, interp, A_DELETE_READ, NULL, 0,
-		TRANSMIT_DONT, P_PRESERVE);
+        ExecuteCallback (dataPtr, interp, A_DELETE_READ,
+		NULL, 0, TRANSMIT_DONT, 1);
     }
 
     /*
-     * General cleanup.
+     * General cleanup
      */
 
     ResultClear(&dataPtr->result);
     Tcl_DecrRefCount(dataPtr->command);
-    ckfree(dataPtr);
+    ckfree((VOID*) dataPtr);
+
     return TCL_OK;
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * TransformInputProc --
+ *	TransformInputProc --
  *
  *	Called by the generic IO system to convert read data.
  *
- * Side effects:
- *	As defined by the conversion.
+ *	Sideeffects:
+ *		As defined by the conversion.
  *
- * Result:
- *	A transformed buffer.
+ *	Result:
+ *		A transformed buffer.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static int
-TransformInputProc(
-    ClientData instanceData,
-    char *buf,
-    int toRead,
-    int *errorCodePtr)
+TransformInputProc (instanceData, buf, toRead, errorCodePtr)
+    ClientData instanceData;
+    char*      buf;
+    int	       toRead;
+    int*       errorCodePtr;
 {
-    TransformChannelData *dataPtr = instanceData;
-    int gotBytes, read, copied;
+    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+    int gotBytes, read, res, 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;
     }
@@ -607,116 +661,113 @@ TransformInputProc(
     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, NULL, A_QUERY_MAXREAD, NULL, 0,
-		TRANSMIT_NUM /* -> maxRead */, P_PRESERVE);
+	ExecuteCallback (dataPtr, NO_INTERP, A_QUERY_MAXREAD,
+		NULL, 0, TRANSMIT_NUM /* -> maxRead */, 1);
 
 	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;
 	}
 
-	/*
-	 * 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;
-	} else if (read == 0) {
+	    return -1;      
+	}
+
+	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.
-		 */
 
-		return gotBytes;
-	    }
+		dataPtr->readIsFlushed = 1;
 
-	    dataPtr->readIsFlushed = 1;
-	    ExecuteCallback(dataPtr, NULL, A_FLUSH_READ, NULL, 0,
-		    TRANSMIT_IBUF, P_PRESERVE);
+		ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_READ,
+			NULL, 0, TRANSMIT_IBUF, P_PRESERVE);
 
-	    if (ResultEmpty(&dataPtr->result)) {
-		/*
-		 * We had nothing to flush.
-		 */
+		if (ResultLength (&dataPtr->result) == 0) {
+		    /* we had nothing to flush */
+		    return gotBytes;
+		}
 
-		return gotBytes;
+		continue; /* at: while (toRead > 0) */
 	    }
-
-	    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)
 	 */
 
-	if (ExecuteCallback(dataPtr, NULL, A_READ, UCHARP(buf), read,
-		TRANSMIT_IBUF, P_PRESERVE) != TCL_OK) {
+	res = ExecuteCallback (dataPtr, NO_INTERP, A_READ,
+		UCHARP (buf), read, TRANSMIT_IBUF, P_PRESERVE);
+
+	if (res != TCL_OK) {
 	    *errorCodePtr = EINVAL;
 	    return -1;
 	}
@@ -726,45 +777,46 @@ TransformInputProc(
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * 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.
  *
- * Side effects:
- *	As defined by the transformation.
+ *	Sideeffects:
+ *		As defined by the transformation.
  *
- * Result:
- *	A transformed buffer.
+ *	Result:
+ *		A transformed buffer.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static int
-TransformOutputProc(
-    ClientData instanceData,
-    const char *buf,
-    int toWrite,
-    int *errorCodePtr)
+TransformOutputProc (instanceData, buf, toWrite, errorCodePtr)
+    ClientData instanceData;
+    CONST char*      buf;
+    int        toWrite;
+    int*       errorCodePtr;
 {
-    TransformChannelData *dataPtr = instanceData;
+    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+    int res;
 
-    /*
-     * 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;
     }
 
-    if (ExecuteCallback(dataPtr, NULL, A_WRITE, UCHARP(buf), toWrite,
-	    TRANSMIT_DOWN, P_NO_PRESERVE) != TCL_OK) {
-	*errorCodePtr = EINVAL;
+    res = ExecuteCallback (dataPtr, NO_INTERP, A_WRITE,
+	    UCHARP (buf), toWrite,
+	    TRANSMIT_DOWN, P_NO_PRESERVE);
+
+    if (res != TCL_OK) {
+        *errorCodePtr = EINVAL;
 	return -1;
     }
 
@@ -772,67 +824,69 @@ TransformOutputProc(
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * 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.
  *
- * 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.
+ *	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.
  *
- * 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(
-    ClientData instanceData,	/* The channel to manipulate. */
-    long offset,		/* Size of movement. */
-    int mode,			/* How to move. */
-    int *errorCodePtr)		/* Location of error flag. */
+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. */
 {
-    TransformChannelData *dataPtr = instanceData;
-    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
-    const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
-    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
+    TransformChannelData* dataPtr	= (TransformChannelData*) 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, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
-		P_NO_PRESERVE);
+        ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
+		NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
     }
 
     if (dataPtr->mode & TCL_READABLE) {
-	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
-		P_NO_PRESERVE);
+        ExecuteCallback (dataPtr, NO_INTERP, 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);
 }
 
 /*
@@ -840,64 +894,71 @@ TransformSeekProc(
  *
  * 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(
-    ClientData instanceData,	/* The channel to manipulate. */
-    Tcl_WideInt offset,		/* Size of movement. */
-    int mode,			/* How to move. */
-    int *errorCodePtr)		/* Location of error flag. */
+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. */
 {
-    TransformChannelData *dataPtr = instanceData;
-    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
-    const 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 =
+	(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);
 
     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, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
-		P_NO_PRESERVE);
+        ExecuteCallback (dataPtr, NO_INTERP, A_FLUSH_WRITE,
+		NULL, 0, TRANSMIT_DOWN, P_NO_PRESERVE);
     }
 
     if (dataPtr->mode & TCL_READABLE) {
-	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
-		P_NO_PRESERVE);
+        ExecuteCallback (dataPtr, NO_INTERP, A_CLEAR_READ,
+		NULL, 0, TRANSMIT_DONT, P_NO_PRESERVE);
 	ResultClear(&dataPtr->result);
 	dataPtr->readIsFlushed = 0;
     }
@@ -905,491 +966,487 @@ TransformWideSeekProc(
     /*
      * 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 reconfiguration 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 reconfi-
+ *	guration of channel specific options. As this
+ *	channel type does not have such, it simply passes
+ *	all requests downstream.
  *
- * Side effects:
- *	As defined by the channel downstream.
+ *	Sideeffects:
+ *		As defined by the channel downstream.
  *
- * Result:
- *	A standard TCL error code.
+ *	Result:
+ *		A standard TCL error code.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static int
-TransformSetOptionProc(
-    ClientData instanceData,
-    Tcl_Interp *interp,
-    const char *optionName,
-    const char *value)
+TransformSetOptionProc (instanceData, interp, optionName, value)
+    ClientData instanceData;
+    Tcl_Interp *interp;
+    CONST char *optionName;
+    CONST char *value;
 {
-    TransformChannelData *dataPtr = instanceData;
+    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
     Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
     Tcl_DriverSetOptionProc *setOptionProc;
 
     setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
-    if (setOptionProc == NULL) {
-	return TCL_ERROR;
+    if (setOptionProc != NULL) {
+	return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan),
+		interp, optionName, value);
     }
-
-    return setOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
-	    optionName, value);
+    return TCL_ERROR;
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * 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.
  *
- * Side effects:
- *	As defined by the channel downstream.
+ *	Sideeffects:
+ *		As defined by the channel downstream.
  *
- * Result:
- *	A standard TCL error code.
+ *	Result:
+ *		A standard TCL error code.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static int
-TransformGetOptionProc(
-    ClientData instanceData,
-    Tcl_Interp *interp,
-    const char *optionName,
-    Tcl_DString *dsPtr)
+TransformGetOptionProc (instanceData, interp, optionName, dsPtr)
+    ClientData   instanceData;
+    Tcl_Interp*  interp;
+    CONST char*        optionName;
+    Tcl_DString* dsPtr;
 {
-    TransformChannelData *dataPtr = instanceData;
+    TransformChannelData* dataPtr = (TransformChannelData*) 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 == NULL) {
+	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
+		interp, optionName, dsPtr);
+    } else if (optionName == (CONST char*) NULL) {
 	/*
 	 * Request is query for all options, this is ok.
 	 */
-
 	return TCL_OK;
     }
-
     /*
-     * Request for a specific option has to fail, since we don't have any.
+     * Request for a specific option has to fail, 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.
  *
- * Side effects:
- *	Sets up the notifier so that a future event on the channel will be
- *	seen by Tcl.
+ *	Sideeffects:
+ *		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(
-    ClientData instanceData,	/* Channel to watch. */
-    int mask)			/* Events of interest. */
+TransformWatchProc (instanceData, mask)
+    ClientData instanceData;	/* Channel to watch */
+    int        mask;		/* Events of interest */
 {
-    TransformChannelData *dataPtr = instanceData;
-    Tcl_Channel downChan;
-
-    /*
-     * The caller expressed interest in events occuring for this channel. We
-     * are forwarding the call to the underlying channel now.
+    /* The caller expressed interest in events occuring for this
+     * channel. We are forwarding the call to the underlying
+     * channel now.
      */
 
+    TransformChannelData* dataPtr = (TransformChannelData*) instanceData;
+    Tcl_Channel     downChan;
+
     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 != 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.
+    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.
 	 */
 
-	Tcl_DeleteTimerHandler(dataPtr->timer);
-	dataPtr->timer = NULL;
+        Tcl_DeleteTimerHandler (dataPtr->timer);
+	dataPtr->timer = (Tcl_TimerToken) NULL;
     }
 
-    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.
+    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.
 	 */
 
-	dataPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY,
-		TransformChannelHandlerTimer, dataPtr);
+	dataPtr->timer = Tcl_CreateTimerHandler (FLUSH_DELAY,
+		TransformChannelHandlerTimer, (ClientData) 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.
  *
- * Side effects:
- *	None.
+ *	Sideeffects:
+ *		None.
  *
- * Result:
- *	The appropriate Tcl_File or NULL if not present.
+ *	Result:
+ *		The appropriate Tcl_File or NULL if not
+ *		present. 
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
-
 static int
-TransformGetFileHandleProc(
-    ClientData instanceData,	/* Channel to query. */
-    int direction,		/* Direction of interest. */
-    ClientData *handlePtr)	/* Place to store the handle into. */
+TransformGetFileHandleProc (instanceData, direction, handlePtr)
+    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.
+ *	------------------------------------------------*
  *
- * Side effects:
- *	May process the incoming event by itself.
+ *	Sideeffects:
+ *		May process the incoming event by itself.
  *
- * Result:
- *	None.
+ *	Result:
+ *		None.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static int
-TransformNotifyProc(
-    ClientData clientData,	/* The state of the notified
-				 * transformation. */
-    int mask)			/* The mask of occuring events. */
+TransformNotifyProc (clientData, mask)
+    ClientData	   clientData; /* The state of the notified transformation */
+    int		   mask;       /* The mask of occuring events */
 {
-    TransformChannelData *dataPtr = clientData;
+    TransformChannelData* dataPtr = (TransformChannelData*) 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 != NULL) {
+    if (dataPtr->timer != (Tcl_TimerToken) 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 = NULL;
+	Tcl_DeleteTimerHandler (dataPtr->timer);
+	dataPtr->timer = (Tcl_TimerToken) 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.
  *
- * Side effects:
- *	As of 'Tcl_NotifyChannel'.
+ *	Sideeffects:
+ *		As of 'Tcl_NotifyChannel'.
  *
- * Result:
- *	None.
+ *	Result:
+ *		None.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
 static void
-TransformChannelHandlerTimer(
-    ClientData clientData)	/* Transformation to query. */
+TransformChannelHandlerTimer (clientData)
+    ClientData clientData; /* Transformation to query */
 {
-    TransformChannelData *dataPtr = clientData;
+    TransformChannelData* dataPtr = (TransformChannelData*) clientData;
 
-    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.
+    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.
 	 */
 
 	return;
     }
+
     Tcl_NotifyChannel(dataPtr->self, TCL_READABLE);
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * ResultClear --
+ *	ResultClear --
  *
  *	Deallocates any memory allocated by 'ResultAdd'.
  *
- * Side effects:
- *	See above.
+ *	Sideeffects:
+ *		See above.
  *
- * Result:
- *	None.
+ *	Result:
+ *		None.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
-static inline void
-ResultClear(
-    ResultBuffer *r)		/* Reference to the buffer to clear out. */
+static void
+ResultClear (r)
+    ResultBuffer* r; /* Reference to the buffer to clear out */
 {
     r->used = 0;
 
     if (r->allocated) {
-	ckfree(r->buf);
-	r->buf = NULL;
+        ckfree((char*) r->buf);
+	r->buf       = UCHARP (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.
  *
- * Side effects:
- *	See above.
+ *	Sideeffects:
+ *		See above.
  *
- * Result:
- *	None.
+ *	Result:
+ *		None.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
-static inline void
-ResultInit(
-    ResultBuffer *r)		/* Reference to the structure to
-				 * initialize. */
+static void
+ResultInit (r)
+    ResultBuffer* r; /* Reference to the structure to initialize */
 {
-    r->used = 0;
+    r->used      = 0;
     r->allocated = 0;
-    r->buf = NULL;
+    r->buf       = UCHARP (NULL);
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * ResultEmpty --
+ *	ResultLength --
  *
- *	Returns whether the number of bytes stored in the buffer is zero.
+ *	Returns the number of bytes stored in the buffer.
  *
- * Side effects:
- *	None.
+ *	Sideeffects:
+ *		None.
  *
- * Result:
- *	A boolean.
+ *	Result:
+ *		An integer, see above too.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
-static inline int
-ResultEmpty(
-    ResultBuffer *r)		/* The structure to query. */
+static int
+ResultLength (r)
+    ResultBuffer* r; /* The structure to query */
 {
-    return r->used == 0;
+    return r->used;
 }
 
 /*
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  *
- * 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.
  *
- * Side effects:
- *	See above.
+ *	Sideeffects:
+ *		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 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. */
+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 */
 {
     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;
-    } else if (r->used == toRead) {
-	/*
-	 * We have just enough. Copy everything to the caller.
+        return 0;
+    }
+
+    if (r->used == toRead) {
+        /* We have just enough. Copy everything to the caller.
 	 */
 
-	memcpy(buf, r->buf, toRead);
+        memcpy ((VOID*) buf, (VOID*) r->buf, (size_t) toRead);
 	r->used = 0;
-    } 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.
-	 */
+	return toRead;
+    }
 
-	memcpy(buf, r->buf, toRead);
-	memmove(r->buf, r->buf + toRead, r->used - toRead);
-	r->used -= toRead;
-    } else {
-	/*
-	 * There is not enough in the buffer to satisfy the caller, so take
-	 * everything.
+    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(buf, r->buf, r->used);
-	toRead = r->used;
-	r->used = 0;
+        memcpy  ((VOID*) buf,    (VOID*) r->buf,            (size_t) toRead);
+	memmove ((VOID*) r->buf, (VOID*) (r->buf + toRead),
+		(size_t) r->used - toRead);
+
+	r->used -= toRead;
+	return toRead;
     }
+
+    /* 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;
     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.
  *
- * Side effects:
- *	See above.
+ *	Sideeffects:
+ *		See above.
  *
- * Result:
- *	None.
+ *	Result:
+ *		None.
  *
- *----------------------------------------------------------------------
+ *------------------------------------------------------*
  */
 
-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'. */
+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' */
 {
-    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 = ckalloc(r->allocated);
+	    r->buf       = UCHARP (ckalloc((unsigned) r->allocated));
 	} else {
 	    r->allocated += toWrite + INCREMENT;
-	    r->buf = ckrealloc(r->buf, r->allocated);
+	    r->buf        = UCHARP (ckrealloc((char*) r->buf,
+		    (unsigned) r->allocated));
 	}
     }
 
-    /*
-     * Now we may copy the data.
-     */
-
-    memcpy(r->buf + r->used, buf, toWrite);
+    /* now copy data */
+    memcpy(r->buf + r->used, buf, (size_t) 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
deleted file mode 100644
index 49e2930..0000000
--- a/generic/tclIORChan.c
+++ /dev/null
@@ -1,3221 +0,0 @@
-/*
- * 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 const 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. */
-
-    int dead;			/* Boolean signal that some operations
-				 * should no longer be attempted. */
-
-    /*
-     * 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 *const eventOptions[] = {
-    "read", "write", NULL
-};
-typedef enum {
-    EVENT_READ, EVENT_WRITE
-} EventOption;
-
-/*
- * Method literals. ==================================================
- */
-
-static const char *const 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 void		FreeReflectedChannelArgs(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) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s initialize\" returned non-list: %s",
-                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
-	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) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" does not support all required methods",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" lacks a \"read\" method",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" lacks a \"write\" method",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
-                Tcl_GetString(cmdObj)));
-	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 = 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 && 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_SetResult(interp, (char *)chanPtr->state->channelName, TCL_VOLATILE);
-    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 = 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 = 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;
-
-	    if (result != TCL_OK) {
-		FreeReceivedError(&p);
-	    }
-	}
-#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;
-
-        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
-
-	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->dead) {
-	    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 = 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 = 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 = 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 = 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 = 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 = 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 = 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;
-	const 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, Contract:
- *	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);
-    /* assert evObj.refCount == 1 */
-    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 = 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;
-    rcPtr->dead = 0;
-#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 = 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
-FreeReflectedChannelArgs(
-    ReflectedChannel *rcPtr)
-{
-    int i, n = rcPtr->argc - 2;
-
-    if (n < 0) {
-	return;
-    }
-    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]);
-
-    rcPtr->argc = 1;
-}
-
-static void
-FreeReflectedChannel(
-    ReflectedChannel *rcPtr)
-{
-    Channel *chanPtr = (Channel *) rcPtr->chan;
-
-    if (chanPtr->typePtr != &tclRChannelType) {
-	/*
-	 * Delete a cloned ChannelType structure.
-	 */
-
-	ckfree(chanPtr->typePtr);
-	chanPtr->typePtr = NULL;
-    }
-
-    FreeReflectedChannelArgs(rcPtr);
-
-    ckfree(rcPtr->argv);
-    ckfree(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->dead) {
-	/*
-	 * 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.
-     *
-     * Because of the contract there is no need to increment the refcounts.
-     * The objects will survive the Tcl_EvalObjv without change.
-     */
-
-    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->dead) {
-	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 = 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 = clientData;
-				/* 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.
-     */
-
-    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
-	    hPtr != NULL;
-	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
-	chan = Tcl_GetHashValue(hPtr);
-	rcPtr = Tcl_GetChannelInstanceData(chan);
-
-	rcPtr->dead = 1;
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(&rcmPtr->map);
-    ckfree(&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;
-
-	/* Basic crash safety until this routine can get revised [3411310] */
-	if (evPtr == NULL) {
-	    continue;
-	}
-	paramPtr = evPtr->param;
-
-	evPtr->resultPtr = NULL;
-	resultPtr->evPtr = NULL;
-	resultPtr->result = TCL_ERROR;
-
-	ForwardSetStaticError(paramPtr, msg_send_dstlost);
-
-	Tcl_ConditionNotify(&resultPtr->done);
-    }
-    Tcl_MutexUnlock(&rcForwardMutex);
-
-    /*
-     * 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_GetHashValue(hPtr);
-	rcPtr = Tcl_GetChannelInstanceData(chan);
-
-	if (rcPtr->interp != interp) {
-	    /*
-	     * Ignore entries for other interpreters.
-	     */
-
-	    continue;
-	}
-
-	rcPtr->dead = 1;
-	FreeReflectedChannelArgs(rcPtr);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-#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(void)
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (!tsdPtr->rcmPtr) {
-	tsdPtr->rcmPtr = 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 */
-    ForwardingResult *resultPtr;
-
-    /*
-     * 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) {
-	ForwardingEvent *evPtr;
-	ForwardParam *paramPtr;
-
-	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;
-
-	/* Basic crash safety until this routine can get revised [3411310] */
-	if (evPtr == NULL ) {
-	    continue;
-	}
-	paramPtr = evPtr->param;
-
-	evPtr->resultPtr = NULL;
-	resultPtr->evPtr = NULL;
-	resultPtr->result = TCL_ERROR;
-
-	ForwardSetStaticError(paramPtr, msg_send_dstlost);
-
-	Tcl_ConditionNotify(&resultPtr->done);
-    }
-    Tcl_MutexUnlock(&rcForwardMutex);
-
-    /*
-     * 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)) {
-	Tcl_Channel chan = Tcl_GetHashValue(hPtr);
-	ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
-
-	rcPtr->dead = 1;
-	FreeReflectedChannelArgs(rcPtr);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    ckfree(rcmPtr);
-}
-
-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->dead) {
-	/*
-	 * 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 = ckalloc(sizeof(ForwardingEvent));
-    resultPtr = 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. Exit 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, 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, evPtr);
-
-    ckfree(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);
-
-	FreeReflectedChannelArgs(rcPtr);
-	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) {
-		Tcl_DecrRefCount(resObj);
-		resObj = MarshallError(interp);
-		ForwardSetObjError(paramPtr, resObj);
-		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 {
-		Tcl_DecrRefCount(resObj);
-		resObj = MarshallError(interp);
-		ForwardSetObjError(paramPtr, resObj);
-		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) {
-		Tcl_DecrRefCount(resObj);
-		resObj = MarshallError(interp);
-		ForwardSetObjError(paramPtr, resObj);
-	    } 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 = 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(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/tclIORTrans.c b/generic/tclIORTrans.c
deleted file mode 100644
index 6c9a41b..0000000
--- a/generic/tclIORTrans.c
+++ /dev/null
@@ -1,3421 +0,0 @@
-/*
- * tclIORTrans.c --
- *
- *	This file contains the implementation of Tcl's generic transformation
- *	reflection code, which allows the implementation of Tcl channel
- *	transformations in Tcl code.
- *
- *	Parts of this file are based on code contributed by Jean-Claude
- *	Wippler.
- *
- *	See TIP #230 for the specification of this functionality.
- *
- * Copyright (c) 2007-2008 ActiveState.
- *
- * 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
-
-/* DUPLICATE of HaveVersion() in tclIO.c // TODO - MODULE_SCOPE */
-static int		HaveVersion(const Tcl_ChannelType *typePtr,
-			    Tcl_ChannelTypeVersion minimumVersion);
-
-/*
- * 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);
-static int		ReflectHandle(ClientData clientData, int direction,
-			    ClientData *handle);
-static int		ReflectNotify(ClientData clientData, int mask);
-
-/*
- * The C layer channel type/driver definition used by the reflection.
- */
-
-static const Tcl_ChannelType tclRTransformType = {
-    "tclrtransform",		/* 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. */
-    ReflectSetOption,		/* Set options. */
-    ReflectGetOption,		/* Get options. */
-    ReflectWatch,		/* Initialize notifier. */
-    ReflectHandle,		/* Get OS handle from the channel. */
-    NULL,			/* No close2 support. NULL'able. */
-    ReflectBlock,		/* Set blocking/nonblocking. */
-    NULL,			/* Flush channel. Not used by core.
-				 * NULL'able. */
-    ReflectNotify,		/* Handle events. */
-    ReflectSeekWide,		/* Move access point (64 bit). */
-    NULL,			/* thread action */
-    NULL			/* truncate */
-};
-
-/*
- * Structure of the buffer to hold transform results to be consumed by higher
- * layers upon reading from the channel, plus the functions to manage such.
- */
-
-typedef 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. */
-} ResultBuffer;
-
-#define ResultLength(r) ((r)->used)
-/* static int		ResultLength(ResultBuffer *r); */
-
-static void		ResultClear(ResultBuffer *r);
-static void		ResultInit(ResultBuffer *r);
-static void		ResultAdd(ResultBuffer *r, unsigned char *buf,
-			    int toWrite);
-static int		ResultCopy(ResultBuffer *r, unsigned char *buf,
-			    int toRead);
-
-#define RB_INCREMENT (512)
-
-/*
- * Convenience macro to make some casts easier to use.
- */
-
-#define UCHARP(x)	((unsigned char *) (x))
-
-/*
- * Instance data for a reflected transformation. ===========================
- */
-
-typedef struct {
-    Tcl_Channel chan;		/* Back reference to the channel of the
-				 * transformation itself. */
-    Tcl_Channel parent;		/* Reference to the channel the transformation
-				 * was pushed on. */
-    Tcl_Interp *interp;		/* Reference to the interpreter containing the
-				 * Tcl level part of the channel. */
-    Tcl_Obj *handle;		/* Reference to transform handle. Also stored
-				 * in the argv, see below. The separate field
-				 * gives us direct access, needed when working
-				 * with the reflection maps. */
-#ifdef TCL_THREADS
-    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
-#endif
-
-    Tcl_TimerToken timer;
-
-    /* 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 nonblocking;		/* Flag: Channel is blocking or not. */
-    int readIsDrained;		/* Flag: Read buffers are flushed. */
-    int dead;			/* Boolean signal that some operations
-				 * should no longer be attempted. */
-    ResultBuffer result;
-} ReflectedTransform;
-
-/*
- * Structure of the table mapping from transform handles to reflected
- * transform (channels). Each interpreter which has the handler command for
- * one or more reflected transforms records them in such a table, so that we
- * are able to find them during interpreter/thread cleanup even if the actual
- * channel they belong to 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;
-} ReflectedTransformMap;
-
-#define RTMKEY "ReflectedTransformMap"
-
-/*
- * Method literals. ==================================================
- */
-
-static const char *const methodNames[] = {
-    "clear",		/* OPT */
-    "drain",		/* OPT, drain => read */
-    "finalize",		/*     */
-    "flush",		/* OPT, flush => write */
-    "initialize",	/*     */
-    "limit?",		/* OPT */
-    "read",		/* OPT */
-    "write",		/* OPT */
-    NULL
-};
-typedef enum {
-    METH_CLEAR,
-    METH_DRAIN,
-    METH_FINAL,
-    METH_FLUSH,
-    METH_INIT,
-    METH_LIMIT,
-    METH_READ,
-    METH_WRITE
-} MethodName;
-
-#define FLAG(m) (1 << (m))
-#define REQUIRED_METHODS \
-	(FLAG(METH_INIT) | FLAG(METH_FINAL))
-#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 {
-    ForwardedClear,
-    ForwardedClose,
-    ForwardedDrain,
-    ForwardedFlush,
-    ForwardedInput,
-    ForwardedLimit,
-    ForwardedOutput
-} 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 ForwardParamTransform {
-    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
-    char *buf;			/* I: Bytes to transform,
-				 * O: Bytes in transform result */
-    int size;			/* I: #bytes to transform,
-				 * O: #bytes in the transform result */
-};
-struct ForwardParamLimit {
-    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
-    int max;			/* O: Character read limit */
-};
-
-/*
- * Now join all these together in a single union for convenience.
- */
-
-typedef union ForwardParam {
-    ForwardParamBase base;
-    struct ForwardParamTransform transform;
-    struct ForwardParamLimit limit;
-} 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 */
-    ReflectedTransform *rtPtr;	/* 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. */
-    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 transformations owned by this thread.
-     */
-
-    ReflectedTransformMap *rtmPtr;
-} 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(rtForwardMutex)
-
-/*
- * 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 two ExitProcs are handlers so that things do not deadlock when either
- * thread involved in the forwarding exits. They also clean things up so that
- * we don't leak resources when threads go away.
- */
-
-static void		ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
-			    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 ReflectedTransformMap *	GetThreadReflectedTransformMap(void);
-static void		DeleteThreadReflectedTransformMap(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 Tcl_Obj *	DecodeEventMask(int mask);
-static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp,
-			    Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj,
-			    Tcl_Channel parentChan);
-static Tcl_Obj *	NextHandle(void);
-static void		FreeReflectedTransform(ReflectedTransform *rtPtr);
-static void		FreeReflectedTransformArgs(ReflectedTransform *rtPtr);
-static int		InvokeTclMethod(ReflectedTransform *rtPtr,
-			    const char *method, Tcl_Obj *argOneObj,
-			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);
-
-static ReflectedTransformMap *	GetReflectedTransformMap(Tcl_Interp *interp);
-static void		DeleteReflectedTransformMap(ClientData clientData,
-			    Tcl_Interp *interp);
-
-/*
- * 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_write_unsup = "{write not supported by Tcl driver}";
-#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}";
-
-/*
- * Timer management (flushing out buffered data via artificial events).
- */
-
-/*
- * Number of milliseconds to wait before firing an event to try to flush out
- * information waiting in buffers (fileevent support).
- */
-
-#define FLUSH_DELAY	(5)
-
-/*
- * Helper functions encapsulating some of the thread forwarding to make the
- * control flow in callers easier.
- */
-
-static void		TimerKill(ReflectedTransform *rtPtr);
-static void		TimerSetup(ReflectedTransform *rtPtr);
-static void		TimerRun(ClientData clientData);
-static int		TransformRead(ReflectedTransform *rtPtr,
-			    int *errorCodePtr, unsigned char *buf,
-			    int toRead);
-static int		TransformWrite(ReflectedTransform *rtPtr,
-			    int *errorCodePtr, unsigned char *buf,
-			    int toWrite);
-static int		TransformDrain(ReflectedTransform *rtPtr,
-			    int *errorCodePtr);
-static int		TransformFlush(ReflectedTransform *rtPtr,
-			    int *errorCodePtr, int op);
-static void		TransformClear(ReflectedTransform *rtPtr);
-static int		TransformLimit(ReflectedTransform *rtPtr,
-			    int *errorCodePtr, int *maxPtr);
-
-/*
- * Operation codes for TransformFlush().
- */
-
-#define FLUSH_WRITE	1
-#define FLUSH_DISCARD	0
-
-/*
- * Main methods to plug into the 'chan' ensemble'. ==================
- */
-
-/*
- *----------------------------------------------------------------------
- *
- * TclChanPushObjCmd --
- *
- *	This function is invoked to process the "chan push" 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
-TclChanPushObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    ReflectedTransform *rtPtr;	/* Instance data of the new (transform)
-				 * channel. */
-    Tcl_Obj *chanObj;		/* Handle of parent channel */
-    Tcl_Channel parentChan;	/* Token of parent channel */
-    int mode;			/* R/W mode of parent, later the new channel.
-				 * Has to match the abilities of the handler
-				 * commands */
-    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
-    Tcl_Obj *cmdNameObj;	/* Command name */
-    Tcl_Obj *rtId;		/* Handle of the new transform (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. */
-    Tcl_Obj *err;		/* Error message */
-    ReflectedTransformMap *rtmPtr;
-				/* Map of reflected transforms with handlers
-				 * in this interp. */
-    Tcl_HashEntry *hPtr;	/* Entry in the above map */
-    int isNew;			/* Placeholder. */
-
-    /*
-     * Syntax:   chan push CHANNEL CMDPREFIX
-     *           [0]  [1]  [2]     [3]
-     *
-     * Actually: rPush CHANNEL CMDPREFIX
-     *           [0]   [1]     [2]
-     */
-
-#define CHAN	(1)
-#define CMD	(2)
-
-    /*
-     * Number of arguments...
-     */
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channel cmdprefix");
-	return TCL_ERROR;
-    }
-
-    /*
-     * First argument is a channel handle.
-     */
-
-    chanObj = objv[CHAN];
-    parentChan = Tcl_GetChannel(interp, Tcl_GetString(chanObj), &mode);
-    if (parentChan == NULL) {
-	return TCL_ERROR;
-    }
-    parentChan = Tcl_GetTopChannel(parentChan);
-
-    /*
-     * 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 transformation (channel).
-     */
-
-    rtId = NextHandle();
-    rtPtr = NewReflectedTransform(interp, cmdObj, mode, rtId, parentChan);
-
-    /*
-     * Invoke 'initialize' and validate that the handler is present and ok.
-     * Squash the transformation if not.
-     */
-
-    modeObj = DecodeEventMask(mode);
-    /* assert modeObj.refCount == 1 */
-    result = InvokeTclMethod(rtPtr, "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) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s initialize\" returned non-list: %s",
-                Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
-	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) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" does not support all required methods",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    /*
-     * Mode tell us what the parent channel supports. The methods tell us what
-     * the handler supports. We remove the non-supported bits from the mode
-     * and check that the channel is not completely inacessible. Afterward the
-     * mode tells us which methods are still required, and these methods will
-     * also be supported by the handler, by design of the check.
-     */
-
-    if (!HAS(methods, METH_READ)) {
-	mode &= ~TCL_READABLE;
-    }
-    if (!HAS(methods, METH_WRITE)) {
-	mode &= ~TCL_WRITABLE;
-    }
-
-    if (!mode) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" makes the channel inaccessible",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    /*
-     * The mode and support for it is ok, now check the internal constraints.
-     */
-
-    if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" supports \"drain\" but not \"read\"",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                "chan handler \"%s\" supports \"flush\" but not \"write\"",
-                Tcl_GetString(cmdObj)));
-	goto error;
-    }
-
-    Tcl_ResetResult(interp);
-
-    /*
-     * Everything is fine now.
-     */
-
-    rtPtr->methods = methods;
-    rtPtr->mode = mode;
-    rtPtr->chan = Tcl_StackChannel(interp, &tclRTransformType, rtPtr, mode,
-	    rtPtr->parent);
-
-    /*
-     * Register the transform in our our map for proper handling of deleted
-     * interpreters and/or threads.
-     */
-
-    rtmPtr = GetReflectedTransformMap(interp);
-    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
-    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
-	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
-    }
-    Tcl_SetHashValue(hPtr, rtPtr);
-#ifdef TCL_THREADS
-    rtmPtr = GetThreadReflectedTransformMap();
-    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
-    Tcl_SetHashValue(hPtr, rtPtr);
-#endif
-
-    /*
-     * Return the channel as the result of the command.
-     */
-
-    Tcl_AppendResult(interp, Tcl_GetChannelName(rtPtr->chan), NULL);
-    return TCL_OK;
-
-  error:
-    /*
-     * We are not going through ReflectClose as we never had a channel
-     * structure.
-     */
-
-    Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
-    return TCL_ERROR;
-
-#undef CHAN
-#undef CMD
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclChanPopObjCmd --
- *
- *	This function is invoked to process the "chan pop" 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
-TclChanPopObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    /*
-     * Syntax:   chan pop CHANNEL
-     *           [0]  [1] [2]
-     *
-     * Actually: rPop CHANNEL
-     *           [0]  [1]
-     */
-
-#define CHAN	(1)
-
-    const char *chanId;		/* Tcl level channel handle */
-    Tcl_Channel chan;		/* Channel associated to the handle */
-    int mode;			/* Channel r/w mode */
-
-    /*
-     * Number of arguments...
-     */
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "channel");
-	return TCL_ERROR;
-    }
-
-    /*
-     * First argument is a channel, which may have a (reflected)
-     * transformation.
-     */
-
-    chanId = TclGetString(objv[CHAN]);
-    chan = Tcl_GetChannel(interp, chanId, &mode);
-
-    if (chan == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Removing transformations is generic, and not restricted to reflected
-     * transformations.
-     */
-
-    Tcl_UnstackChannel(interp, chan);
-    return TCL_OK;
-
-#undef CHAN
-}
-
-/*
- * 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]);
-    }
-
-    Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
-    ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED;
-}
-
-/*
- * 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)
-{
-    ReflectedTransform *rtPtr = clientData;
-    int errorCode, errorCodeSet = 0;
-    int result = TCL_OK;	/* Result code for 'close' */
-    Tcl_Obj *resObj;		/* Result data for 'close' */
-    ReflectedTransformMap *rtmPtr;
-				/* Map of reflected transforms 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: DeleteThreadReflectedTransformMap() is the thread exit handler
-	 * for the origin thread. Use this to clean up the structure? Except
-	 * if lost?
-	 */
-
-#ifdef TCL_THREADS
-	if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	    ForwardParam p;
-
-	    ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
-	    result = p.base.code;
-
-	    if (result != TCL_OK) {
-		FreeReceivedError(&p);
-	    }
-	}
-#endif
-
-	Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
-	return EOK;
-    }
-
-    /*
-     * In the reflected channel implementation a cleaned method mask here
-     * implies that the channel creation was aborted, and "finalize" must not
-     * be called. for transformations however we are not going through here on
-     * such an abort, but directly through FreeReflectedTransform. So for us
-     * that check is not necessary. We always go through 'finalize'.
-     */
-
-    if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
-	if (!TransformDrain(rtPtr, &errorCode)) {
-#ifdef TCL_THREADS
-	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-		Tcl_EventuallyFree (rtPtr,
-			(Tcl_FreeProc *) FreeReflectedTransform);
-		return errorCode;
-	    } 
-#endif
-	    errorCodeSet = 1;
-	    goto cleanup;
-	}
-    }
-
-    if (HAS(rtPtr->methods, METH_FLUSH)) {
-	if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
-#ifdef TCL_THREADS
-	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-		Tcl_EventuallyFree (rtPtr,
-			(Tcl_FreeProc *) FreeReflectedTransform);
-		return errorCode;
-	    } 
-#endif
-	    errorCodeSet = 1;
-	    goto cleanup;
-	}
-    }
-
-    /*
-     * Are we in the correct thread?
-     */
-
-#ifdef TCL_THREADS
-    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	ForwardParam p;
-
-	ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
-	result = p.base.code;
-
-	Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
-
-	if (result != TCL_OK) {
-	    PassReceivedErrorInterp(interp, &p);
-	    return EINVAL;
-	}
-	return EOK;
-    }
-#endif
-
-    /*
-     * Do the actual invokation of "finalize" now; we're in the right thread.
-     */
-
-    result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
-    if ((result != TCL_OK) && (interp != NULL)) {
-	Tcl_SetChannelErrorInterp(interp, resObj);
-    }
-
-    Tcl_DecrRefCount(resObj);	/* Remove reference we held from the
-				 * invoke. */
-
-  cleanup:
-
-    /*
-     * Remove the transform from the map before releasing the memory, to
-     * prevent future accesses from finding and dereferencing a dangling
-     * pointer.
-     *
-     * NOTE: The transform may not be in the map. This is ok, that happens
-     * when the transform 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 DeleteReflectedTransformMap exit-handler.
-     */
-
-    if (!rtPtr->dead) {
-	rtmPtr = GetReflectedTransformMap(rtPtr->interp);
-	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
-	if (hPtr) {
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-
-	/*
-	 * In a threaded interpreter we manage a per-thread map as well,
-	 * to allow us to survive if the script level pulls the rug out
-	 * under a channel by deleting the owning thread.
-	 */
-
-#ifdef TCL_THREADS
-	rtmPtr = GetThreadReflectedTransformMap();
-	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
-	if (hPtr) {
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-#endif
-    }
-
-    Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
-    return errorCodeSet ? errorCode : ((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)
-{
-    ReflectedTransform *rtPtr = clientData;
-    int gotBytes, copied, readBytes;
-
-    /*
-     * 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 (!(rtPtr->methods & FLAG(METH_READ))) {
-	SetChannelErrorStr(rtPtr->chan, msg_read_unsup);
-	*errorCodePtr = EINVAL;
-	return -1;
-    }
-
-    Tcl_Preserve(rtPtr);
-
-    gotBytes = 0;
-    while (toRead > 0) {
-	/*
-	 * Loop until the request is satisfied (or no data available from
-	 * below, possibly EOF).
-	 */
-
-	copied = ResultCopy(&rtPtr->result, UCHARP(buf), toRead);
-	toRead -= copied;
-	buf += copied;
-	gotBytes += copied;
-
-	if (toRead == 0) {
-	    goto stop;
-	}
-
-	/*
-	 * The buffer is exhausted, but the caller wants even more. We now
-	 * have to go to the underlying channel, get more bytes and then
-	 * transform them for delivery. We may not get what we want (full EOF
-	 * or temporarily out of data).
-	 *
-	 * Length (rtPtr->result) == 0, toRead > 0 here. Use 'buf'! as target
-	 * to store the intermediary information read from the parent channel.
-	 *
-	 * Ask the transform 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' for example, either through counting bytes, or by
-	 * pattern matching.
-	 */
-
-	if ((rtPtr->methods & FLAG(METH_LIMIT))) {
-	    int maxRead = -1;
-
-	    if (!TransformLimit(rtPtr, errorCodePtr, &maxRead)) {
-		goto error;
-	    }
-	    if (maxRead == 0) {
-		goto stop;
-	    } else if (maxRead > 0) {
-		if (maxRead < toRead) {
-		    toRead = maxRead;
-		}
-	    } /* else: 'maxRead < 0' == Accept the current value of toRead */
-	}
-
-	if (toRead <= 0) {
-	    goto stop;
-	}
-
-	readBytes = Tcl_ReadRaw(rtPtr->parent, buf, toRead);
-	if (readBytes < 0) {
-	    /*
-	     * Report errors to caller. The state of the seek system is
-	     * unchanged!
-	     */
-
-	    if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) {
-		/*
-		 * EAGAIN is a special situation. If we had some data before
-		 * we report that instead of the request to re-try.
-		 */
-
-		goto stop;
-	    }
-
-	    *errorCodePtr = Tcl_GetErrno();
-	    goto error;
-	}
-
-	if (readBytes == 0) {
-	    /*
-	     * Check wether we hit on EOF in 'parent' 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(rtPtr->parent)) {
-		/*
-		 * The state of the seek system is unchanged!
-		 */
-
-		if ((gotBytes == 0) && rtPtr->nonblocking) {
-		    *errorCodePtr = EWOULDBLOCK;
-		    goto error;
-		}
-		goto stop;
-	    } else {
-		/*
-		 * Eof in parent.
-		 */
-
-		if (rtPtr->readIsDrained) {
-		    goto stop;
-		}
-
-		/*
-		 * Now this is a bit different. The partial data waiting is
-		 * converted and returned.
-		 */
-
-		if (HAS(rtPtr->methods, METH_DRAIN)) {
-		    if (!TransformDrain(rtPtr, errorCodePtr)) {
-			goto error;
-		    }
-		}
-
-		if (ResultLength(&rtPtr->result) == 0) {
-		    /*
-		     * The drain delivered nothing.
-		     */
-
-		    goto stop;
-		}
-
-		/*
-		 * Reset eof, force caller to drain result buffer.
-		 */
-
-		((Channel *) rtPtr->parent)->state->flags &= ~CHANNEL_EOF;
-		continue; /* at: while (toRead > 0) */
-	    }
-	} /* readBytes == 0 */
-
-	/*
-	 * Transform the read chunk, which was not empty. Anything we got back
-	 * is a transformation result is put into our buffers, and the next
-	 * iteration will put it into the result.
-	 */
-
-	if (!TransformRead(rtPtr, errorCodePtr, UCHARP(buf), readBytes)) {
-	    goto error;
-	}
-    } /* while toRead > 0 */
-
- stop:
-    Tcl_Release(rtPtr);
-    return gotBytes;
-
- error:
-    gotBytes = -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)
-{
-    ReflectedTransform *rtPtr = clientData;
-
-    /*
-     * 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 (!(rtPtr->methods & FLAG(METH_WRITE))) {
-	SetChannelErrorStr(rtPtr->chan, msg_write_unsup);
-	*errorCodePtr = EINVAL;
-	return -1;
-    }
-
-    if (toWrite == 0) {
-	/*
-	 * Nothing came in to write, ignore the call
-	 */
-
-	return 0;
-    }
-
-    /*
-     * Discard partial data in the input buffers, i.e. on the read side. Like
-     * we do when explicitly seeking as well.
-     */
-
-    Tcl_Preserve(rtPtr);
-
-    if ((rtPtr->methods & FLAG(METH_CLEAR))) {
-	TransformClear(rtPtr);
-    }
-
-    /*
-     * Hand the data to the transformation itself. Anything it deigned to
-     * return to us is a (partial) transformation result and written to the
-     * parent channel for further processing.
-     */
-
-    if (!TransformWrite(rtPtr, errorCodePtr, UCHARP(buf), toWrite)) {
-	Tcl_Release(rtPtr);
-	return -1;
-    }
-
-    *errorCodePtr = EOK;
-    Tcl_Release(rtPtr);
-    return toWrite;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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, per the parent channel, and the called
- *	scripts.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_WideInt
-ReflectSeekWide(
-    ClientData clientData,
-    Tcl_WideInt offset,
-    int seekMode,
-    int *errorCodePtr)
-{
-    ReflectedTransform *rtPtr = clientData;
-    Channel *parent = (Channel *) rtPtr->parent;
-    Tcl_WideInt curPos;		/* Position on the device. */
-
-    Tcl_DriverSeekProc *seekProc =
-	    Tcl_ChannelSeekProc(Tcl_GetChannelType(rtPtr->parent));
-
-    /*
-     * Fail if the parent channel is not seekable.
-     */
-
-    if (seekProc == NULL) {
-	Tcl_SetErrno(EINVAL);
-	return Tcl_LongAsWide(-1);
-    }
-
-    /*
-     * Check if we can leave out involving the Tcl level, i.e. transformation
-     * handler. This is true for tell requests, and transformations which
-     * support neither flush, nor drain. For these cases we can pass the
-     * request down and the result back up unchanged.
-     */
-
-    Tcl_Preserve(rtPtr);
-
-    if (((seekMode != SEEK_CUR) || (offset != 0))
-	    && (HAS(rtPtr->methods, METH_CLEAR)
-	    || HAS(rtPtr->methods, METH_FLUSH))) {
-	/*
-	 * Neither a tell request, nor clear/flush both not supported. We have
-	 * to go through the Tcl level to clear and/or flush the
-	 * transformation.
-	 */
-
-	if ((rtPtr->methods & FLAG(METH_CLEAR))) {
-	    TransformClear(rtPtr);
-	}
-
-	/*
-	 * When flushing the transform for seeking the generated results are
-	 * irrelevant. We cannot put them into the channel, this would move
-	 * the location, throwing it off with regard to where we are and are
-	 * seeking to.
-	 */
-
-	if (HAS(rtPtr->methods, METH_FLUSH)) {
-	    if (!TransformFlush(rtPtr, errorCodePtr, FLUSH_DISCARD)) {
-		Tcl_Release(rtPtr);
-		return -1;
-	    }
-	}
-    }
-
-    /*
-     * 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(parent->typePtr, TCL_CHANNEL_VERSION_3) &&
-	parent->typePtr->wideSeekProc != NULL) {
-	curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
-		seekMode, errorCodePtr);
-    } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
-	    offset > Tcl_LongAsWide(LONG_MAX)) {
-	*errorCodePtr = EOVERFLOW;
-	curPos = Tcl_LongAsWide(-1);
-    } else {
-	curPos = Tcl_LongAsWide(parent->typePtr->seekProc(
-		parent->instanceData, Tcl_WideAsLong(offset), seekMode,
-		errorCodePtr));
-    }
-    if (curPos == Tcl_LongAsWide(-1)) {
-	Tcl_SetErrno(*errorCodePtr);
-    }
-
-    *errorCodePtr = EOK;
-    Tcl_Release(rtPtr);
-    return curPos;
-}
-
-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)
-{
-    ReflectedTransform *rtPtr = clientData;
-    Tcl_DriverWatchProc *watchProc;
-
-    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(rtPtr->parent));
-    watchProc(Tcl_GetChannelInstanceData(rtPtr->parent), mask);
-
-    /*
-     * Management of the internal timer.
-     */
-
-    if (!(mask & TCL_READABLE) || (ResultLength(&rtPtr->result) == 0)) {
-	/*
-	 * A pending timer may exist, but either is there no (more) interest
-	 * in the events it generates or nothing is available for reading.
-	 * Remove it, if existing.
-	 */
-
-	TimerKill(rtPtr);
-    } else {
-	/*
-	 * There might be no pending timer, but there is interest in readable
-	 * events and we actually have data waiting, so generate a timer to
-	 * flush that if it does not exist.
-	 */
-
-	TimerSetup(rtPtr);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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)
-{
-    ReflectedTransform *rtPtr = clientData;
-
-    /*
-     * Transformations simply record the blocking mode in their C level
-     * structure for use by --> ReflectInput. The Tcl level doesn't see this
-     * information or change. As such thread forwarding is not required.
-     */
-
-    rtPtr->nonblocking = nonblocking;
-    return EOK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ReflectSetOption --
- *
- *	This function is invoked to configure a channel option.
- *
- * Results:
- *	A standard Tcl result code.
- *
- * Side effects:
- *	Arbitrary, per the parent channel.
- *
- *----------------------------------------------------------------------
- */
-
-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 */
-{
-    ReflectedTransform *rtPtr = clientData;
-
-    /*
-     * Transformations have no options. Thus the call is passed down unchanged
-     * to the parent channel for processing. Its results are passed back
-     * unchanged as well. This all happens in the thread we are in. As the Tcl
-     * level is not involved there is no need for thread forwarding.
-     */
-
-    Tcl_DriverSetOptionProc *setOptionProc =
-	    Tcl_ChannelSetOptionProc(Tcl_GetChannelType(rtPtr->parent));
-
-    if (setOptionProc == NULL) {
-	return TCL_ERROR;
-    }
-    return setOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent), interp,
-	    optionName, newValue);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ReflectGetOption --
- *
- *	This function is invoked to retrieve all or a channel options.
- *
- * Results:
- *	A standard Tcl result code.
- *
- * Side effects:
- *	Arbitrary, per the parent channel.
- *
- *----------------------------------------------------------------------
- */
-
-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 */
-{
-    ReflectedTransform *rtPtr = clientData;
-
-    /*
-     * Transformations have no options. Thus the call is passed down unchanged
-     * to the parent channel for processing. Its results are passed back
-     * unchanged as well. This all happens in the thread we are in. As the Tcl
-     * level is not involved there is no need for thread forwarding.
-     *
-     * Note that the parent not having a driver for option retrieval is not an
-     * immediate error. A query for all options is ok. Only a request for a
-     * specific option has to fail.
-     */
-
-    Tcl_DriverGetOptionProc *getOptionProc =
-	    Tcl_ChannelGetOptionProc(Tcl_GetChannelType(rtPtr->parent));
-
-    if (getOptionProc != NULL) {
-	return getOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent),
-		interp, optionName, dsPtr);
-    } else if (optionName == NULL) {
-	return TCL_OK;
-    } else {
-	return TCL_ERROR;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ReflectHandle --
- *
- *	This function is invoked to retrieve the associated file handle.
- *
- * Results:
- *	A standard Tcl result code.
- *
- * Side effects:
- *	Arbitrary, per the parent channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ReflectHandle(
-    ClientData clientData,
-    int direction,
-    ClientData *handlePtr)
-{
-    ReflectedTransform *rtPtr = clientData;
-
-    /*
-     * Transformations have no handle of their own. As such we simply query
-     * the parent channel for it. This way the qery will ripple down through
-     * all transformations until reaches the base channel. Which then returns
-     * its handle, or fails. The former will then ripple up the stack.
-     *
-     * This all happens in the thread we are in. As the Tcl level is not
-     * involved no forwarding is required.
-     */
-
-    return Tcl_GetChannelHandle(rtPtr->parent, direction, handlePtr);
-}
-/*
- *----------------------------------------------------------------------
- *
- * ReflectNotify --
- *
- *	This function is invoked to reported incoming events.
- *
- * Results:
- *	A standard Tcl result code.
- *
- * Side effects:
- *	Arbitrary, per the parent channel.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ReflectNotify(
-    ClientData clientData,
-    int mask)
-{
-    ReflectedTransform *rtPtr = clientData;
-
-    /*
-     * An event occured in the underlying channel.
-     *
-     * We delete our 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 ReflectWatch).
-     */
-
-    TimerKill(rtPtr);
-
-    /*
-     * Pass to higher layers.
-     */
-
-    return mask;
-}
-
-/*
- * Helpers. =========================================================
- */
-
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- * DUPLICATE of 'DecodeEventMask' in tclIORChan.c
- */
-
-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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * NewReflectedTransform --
- *
- *	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 ReflectedTransform *
-NewReflectedTransform(
-    Tcl_Interp *interp,
-    Tcl_Obj *cmdpfxObj,
-    int mode,
-    Tcl_Obj *handleObj,
-    Tcl_Channel parentChan)
-{
-    ReflectedTransform *rtPtr;
-    int listc;
-    Tcl_Obj **listv;
-    int i;
-
-    rtPtr = ckalloc(sizeof(ReflectedTransform));
-
-    /* rtPtr->chan: Assigned by caller. Dummy data here. */
-    /* rtPtr->methods: Assigned by caller. Dummy data here. */
-
-    rtPtr->chan = NULL;
-    rtPtr->methods = 0;
-#ifdef TCL_THREADS
-    rtPtr->thread = Tcl_GetCurrentThread();
-#endif
-    rtPtr->parent = parentChan;
-    rtPtr->interp = interp;
-    rtPtr->handle = handleObj;
-    Tcl_IncrRefCount(handleObj);
-    rtPtr->timer = NULL;
-    rtPtr->mode = 0;
-    rtPtr->readIsDrained = 0;
-    rtPtr->nonblocking =
-	    (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
-    rtPtr->dead = 0;
-
-    /*
-     * Query parent for current blocking mode.
-     */
-
-    ResultInit(&rtPtr->result);
-
-    /*
-     * 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
-     */
-
-    rtPtr->argc = listc + 2;
-    rtPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
-
-    /*
-     * Duplicate object references.
-     */
-
-    for (i=0; i<listc ; i++) {
-	Tcl_Obj *word = rtPtr->argv[i] = listv[i];
-
-	Tcl_IncrRefCount(word);
-    }
-
-    i++;				/* Skip placeholder for method */
-
-    /*
-     * See [x] in FreeReflectedTransform for release
-     */
-    rtPtr->argv[i] = handleObj;
-    Tcl_IncrRefCount(handleObj);
-
-    /*
-     * The next two objects are kept empty, varying arguments.
-     */
-
-    /*
-     * Initialization complete.
-     */
-
-    return rtPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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(rtCounterMutex)
-    static unsigned long rtCounter = 0;
-    Tcl_Obj *resObj;
-
-    Tcl_MutexLock(&rtCounterMutex);
-    resObj = Tcl_ObjPrintf("rt%lu", rtCounter);
-    rtCounter++;
-    Tcl_MutexUnlock(&rtCounterMutex);
-
-    return resObj;
-}
-
-static void
-FreeReflectedTransformArgs(
-    ReflectedTransform *rtPtr)
-{
-    int i, n = rtPtr->argc - 2;
-
-    if (n < 0) {
-	return;
-    }
-
-    Tcl_DecrRefCount(rtPtr->handle);
-    rtPtr->handle = NULL;
-
-    for (i=0; i<n; i++) {
-	Tcl_DecrRefCount(rtPtr->argv[i]);
-    }
-
-    /*
-     * See [x] in NewReflectedTransform for lock
-     * n+1 = argc-1.
-     */
-    Tcl_DecrRefCount(rtPtr->argv[n+1]);
-
-    rtPtr->argc = 1;
-}
-
-static void
-FreeReflectedTransform(
-    ReflectedTransform *rtPtr)
-{
-    TimerKill(rtPtr);
-    ResultClear(&rtPtr->result);
-
-    FreeReflectedTransformArgs(rtPtr);
-
-    ckfree(rtPtr->argv);
-    ckfree(rtPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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, ...}
- *
- *----------------------------------------------------------------------
- * Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c
- * - Semi because different structures are used.
- * - Still possible to factor out the commonalities into a separate structure.
- */
-
-static int
-InvokeTclMethod(
-    ReflectedTransform *rtPtr,
-    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 (rtPtr->dead) {
-	/*
-	 * The transform 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);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * NOTE (5): Decide impl. issue: Cache objects with method names?
-     * Requires 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);
-    rtPtr->argv[rtPtr->argc - 2] = methObj;
-
-    /*
-     * Append the additional argument containing method specific details
-     * behind the channel id. If specified.
-     *
-     * Because of the contract there is no need to increment the refcounts.
-     * The objects will survive the Tcl_EvalObjv without change.
-     */
-
-    cmdc = rtPtr->argc;
-    if (argOneObj) {
-	rtPtr->argv[cmdc] = argOneObj;
-	cmdc++;
-	if (argTwoObj) {
-	    rtPtr->argv[cmdc] = argTwoObj;
-	    cmdc++;
-	}
-    }
-
-    /*
-     * And run the handler... This is done in auch a manner which leaves any
-     * existing state intact.
-     */
-
-    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
-    Tcl_Preserve(rtPtr);
-    result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->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(rtPtr->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, rtPtr->argv);
-		int cmdLen;
-		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
-
-		Tcl_IncrRefCount(cmd);
-		Tcl_ResetResult(rtPtr->interp);
-		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
-			"chan handler returned bad code: %d", result));
-		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
-		Tcl_DecrRefCount(cmd);
-		result = TCL_ERROR;
-	    }
-	    Tcl_AppendObjToErrorInfo(rtPtr->interp, Tcl_ObjPrintf(
-		    "\n    (chan handler subcommand \"%s\")", method));
-	    resObj = MarshallError(rtPtr->interp);
-	}
-	Tcl_IncrRefCount(resObj);
-    }
-    Tcl_RestoreInterpState(rtPtr->interp, sr);
-    Tcl_Release(rtPtr);
-
-    /*
-     * 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GetReflectedTransformMap --
- *
- *	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 ReflectedTransformMap *
-GetReflectedTransformMap(
-    Tcl_Interp *interp)
-{
-    ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);
-
-    if (rtmPtr == NULL) {
-	rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
-	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
-	Tcl_SetAssocData(interp, RTMKEY,
-		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
-    }
-    return rtmPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DeleteReflectedTransformMap --
- *
- *	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
-DeleteReflectedTransformMap(
-    ClientData clientData,	/* The per-interpreter data structure. */
-    Tcl_Interp *interp)		/* The interpreter being deleted. */
-{
-    ReflectedTransformMap *rtmPtr; /* The map */
-    Tcl_HashSearch hSearch;	 /* Search variable. */
-    Tcl_HashEntry *hPtr;	 /* Search variable. */
-    ReflectedTransform *rtPtr;
-#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
-     * DeleteThreadReflectedTransformMap(), just restricted to the channels of
-     * this interp.
-     */
-
-    rtmPtr = clientData;
-    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
-	    hPtr != NULL;
-	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
-	rtPtr = Tcl_GetHashValue(hPtr);
-
-	rtPtr->dead = 1;
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    Tcl_DeleteHashTable(&rtmPtr->map);
-    ckfree(&rtmPtr->map);
-
-#ifdef TCL_THREADS
-    /*
-     * The origin interpreter for one or more reflected channels is gone.
-     */
-
-    /*
-     * Get the map of all channels handled by the current thread. This is a
-     * ReflectedTransformMap, 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.
-     */
-
-    rtmPtr = GetThreadReflectedTransformMap();
-    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
-	    hPtr != NULL;
-	    hPtr = Tcl_NextHashEntry(&hSearch)) {
-	rtPtr = Tcl_GetHashValue(hPtr);
-
-	if (rtPtr->interp != interp) {
-	    /*
-	     * Ignore entries for other interpreters.
-	     */
-
-	    continue;
-	}
-
-	rtPtr->dead = 1;
-	FreeReflectedTransformArgs(rtPtr);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-
-    /*
-     * 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(&rtForwardMutex);
-
-    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);
-    }
-    Tcl_MutexUnlock(&rtForwardMutex);
-
-#endif
-}
-
-#ifdef TCL_THREADS
-/*
- *----------------------------------------------------------------------
- *
- * GetThreadReflectedTransformMap --
- *
- *	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 ReflectedTransformMap *
-GetThreadReflectedTransformMap(void)
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (!tsdPtr->rtmPtr) {
-	tsdPtr->rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
-	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
-	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
-    }
-
-    return tsdPtr->rtmPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DeleteThreadReflectedTransformMap --
- *
- *	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
- *	DeleteReflectedTransformMap().
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Deletes the hash table of channels.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DeleteThreadReflectedTransformMap(
-    ClientData clientData)	/* The per-thread data structure. */
-{
-    Tcl_HashSearch hSearch;	 /* Search variable. */
-    Tcl_HashEntry *hPtr;	 /* Search variable. */
-    Tcl_ThreadId self = Tcl_GetCurrentThread();
-    ReflectedTransformMap *rtmPtr; /* The map */
-    ForwardingResult *resultPtr;
-
-    /*
-     * 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 DeleteReflectedTransformMap is apparently not called.
-     */
-
-    /*
-     * Get the map of all channels handled by the current thread. This is a
-     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
-     * through the channels, remove all, mark them as dead.
-     */
-
-    rtmPtr = GetThreadReflectedTransformMap();
-    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
-	    hPtr != NULL;
-	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
-	ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);
-
-	rtPtr->dead = 1;
-	FreeReflectedTransformArgs(rtPtr);
-	Tcl_DeleteHashEntry(hPtr);
-    }
-    ckfree(rtmPtr);
-
-    /*
-     * 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(&rtForwardMutex);
-
-    for (resultPtr = forwardList; resultPtr != NULL;
-	    resultPtr = resultPtr->nextPtr) {
-	ForwardingEvent *evPtr;
-	ForwardParam *paramPtr;
-
-	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);
-    }
-    Tcl_MutexUnlock(&rtForwardMutex);
-}
-
-static void
-ForwardOpToOwnerThread(
-    ReflectedTransform *rtPtr,	/* Channel instance */
-    ForwardedOperation op,	/* Forwarded driver operation */
-    const void *param)		/* Arguments */
-{
-    Tcl_ThreadId dst = rtPtr->thread;
-    ForwardingEvent *evPtr;
-    ForwardingResult *resultPtr;
-
-    /*
-     * We gather the lock early. This allows us to check the liveness of the
-     * channel without interference from DeleteThreadReflectedTransformMap().
-     */
-
-    Tcl_MutexLock(&rtForwardMutex);
-
-    if (rtPtr->dead) {
-	/*
-	 * 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(&rtForwardMutex);
-	return;
-    }
-
-    /*
-     * Create and initialize the event and data structures.
-     */
-
-    evPtr = ckalloc(sizeof(ForwardingEvent));
-    resultPtr = ckalloc(sizeof(ForwardingResult));
-
-    evPtr->event.proc = ForwardProc;
-    evPtr->resultPtr = resultPtr;
-    evPtr->op = op;
-    evPtr->rtPtr = rtPtr;
-    evPtr->param = (ForwardParam *) param;
-
-    resultPtr->src = Tcl_GetCurrentThread();
-    resultPtr->dst = dst;
-    resultPtr->dsti = rtPtr->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. Exit of the destination thread is handled by
-     * DeleteThreadReflectionChannelMap(), this is set up by
-     * GetThreadReflectedTransformMap(). This is what we use the 'forwardList'
-     * (see above) for.
-     */
-
-    Tcl_CreateThreadExitHandler(SrcExitProc, 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, &rtForwardMutex, 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(&rtForwardMutex);
-    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 by the destination
-     * notifier, after it serviced the event.
-     */
-
-    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
-
-    ckfree(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;
-    ReflectedTransform *rtPtr = evPtr->rtPtr;
-    Tcl_Interp *interp = rtPtr->interp;
-    ForwardParam *paramPtr = evPtr->param;
-    Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
-    ReflectedTransformMap *rtmPtr;
-				/* 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
-	 * rtPtr->thread, which contains rtPtr->interp, the interp we have to
-	 * call upon for the driver.
-	 */
-
-    case ForwardedClose:
-	/*
-	 * No parameters/results.
-	 */
-
-	if (InvokeTclMethod(rtPtr, "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
-	 */
-
-	/*
-	 * Remove the channel from the map before releasing the memory, to
-	 * prevent future accesses (like by 'postevent') from finding and
-	 * dereferencing a dangling pointer.
-	 */
-
-	rtmPtr = GetReflectedTransformMap(interp);
-	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
-	Tcl_DeleteHashEntry(hPtr);
-
-	/*
-	 * In a threaded interpreter we manage a per-thread map as well, to
-	 * allow us to survive if the script level pulls the rug out under a
-	 * channel by deleting the owning thread.
-	 */
-
-	rtmPtr = GetThreadReflectedTransformMap();
-	hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
-	Tcl_DeleteHashEntry(hPtr);
-
-	FreeReflectedTransformArgs(rtPtr);
-	break;
-
-    case ForwardedInput: {
-	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
-		paramPtr->transform.buf, paramPtr->transform.size);
-	Tcl_IncrRefCount(bufObj);
-
-	if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
-	    ForwardSetObjError(paramPtr, resObj);
-	    paramPtr->transform.size = -1;
-	} else {
-	    /*
-	     * Process a regular return. Contains the transformation result.
-	     * Sent it back to the request originator.
-	     */
-
-	    int bytec;		/* Number of returned bytes */
-	    unsigned char *bytev;
-				/* Array of returned bytes */
-
-	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-
-	    paramPtr->transform.size = bytec;
-
-	    if (bytec > 0) {
-		paramPtr->transform.buf = ckalloc(bytec);
-		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
-	    } else {
-		paramPtr->transform.buf = NULL;
-	    }
-	}
-
-	Tcl_DecrRefCount(bufObj);
-	break;
-    }
-
-    case ForwardedOutput: {
-	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
-		paramPtr->transform.buf, paramPtr->transform.size);
-	Tcl_IncrRefCount(bufObj);
-
-	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
-	    ForwardSetObjError(paramPtr, resObj);
-	    paramPtr->transform.size = -1;
-	} else {
-	    /*
-	     * Process a regular return. Contains the transformation result.
-	     * Sent it back to the request originator.
-	     */
-
-	    int bytec;		/* Number of returned bytes */
-	    unsigned char *bytev;
-				/* Array of returned bytes */
-
-	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-
-	    paramPtr->transform.size = bytec;
-
-	    if (bytec > 0) {
-		paramPtr->transform.buf = ckalloc(bytec);
-		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
-	    } else {
-		paramPtr->transform.buf = NULL;
-	    }
-	}
-
-	Tcl_DecrRefCount(bufObj);
-	break;
-    }
-
-    case ForwardedDrain: {
-	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
-	    ForwardSetObjError(paramPtr, resObj);
-	    paramPtr->transform.size = -1;
-	} else {
-	    /*
-	     * Process a regular return. Contains the transformation result.
-	     * Sent it back to the request originator.
-	     */
-
-	    int bytec;		/* Number of returned bytes */
-	    unsigned char *bytev; /* Array of returned bytes */
-
-	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-
-	    paramPtr->transform.size = bytec;
-
-	    if (bytec > 0) {
-		paramPtr->transform.buf = ckalloc(bytec);
-		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
-	    } else {
-		paramPtr->transform.buf = NULL;
-	    }
-	}
-	break;
-    }
-
-    case ForwardedFlush: {
-	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
-	    ForwardSetObjError(paramPtr, resObj);
-	    paramPtr->transform.size = -1;
-	} else {
-	    /*
-	     * Process a regular return. Contains the transformation result.
-	     * Sent it back to the request originator.
-	     */
-
-	    int bytec;		/* Number of returned bytes */
-	    unsigned char *bytev;
-				/* Array of returned bytes */
-
-	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-
-	    paramPtr->transform.size = bytec;
-
-	    if (bytec > 0) {
-		paramPtr->transform.buf = ckalloc(bytec);
-		memcpy(paramPtr->transform.buf, bytev, (size_t)bytec);
-	    } else {
-		paramPtr->transform.buf = NULL;
-	    }
-	}
-	break;
-    }
-
-    case ForwardedClear: {
-	(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
-	break;
-    }
-
-    case ForwardedLimit:
-	if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
-	    ForwardSetObjError(paramPtr, resObj);
-	    paramPtr->limit.max = -1;
-	} else if (Tcl_GetIntFromObj(interp, resObj,
-		&paramPtr->limit.max) != TCL_OK) {
-	    ForwardSetObjError(paramPtr, MarshallError(interp));
-	    paramPtr->limit.max = -1;
-	}
-	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(&rtForwardMutex);
-	resultPtr->result = TCL_OK;
-	Tcl_ConditionNotify(&resultPtr->done);
-	Tcl_MutexUnlock(&rtForwardMutex);
-    }
-
-    return 1;
-}
-
-static void
-SrcExitProc(
-    ClientData clientData)
-{
-    ForwardingEvent *evPtr = 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(&rtForwardMutex);
-
-    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(&rtForwardMutex);
-
-    /*
-     * 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(len));
-    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerKill --
- *
- *	Timer management. Removes the internal timer if it exists.
- *
- * Side effects:
- *	See above.
- *
- * Result:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TimerKill(
-    ReflectedTransform *rtPtr)
-{
-    if (rtPtr->timer == NULL) {
-	return;
-    }
-
-    /*
-     * Delete an existing flush-out timer, prevent it from firing on a
-     * removed/dead channel.
-     */
-
-    Tcl_DeleteTimerHandler(rtPtr->timer);
-    rtPtr->timer = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerSetup --
- *
- *	Timer management. Creates the internal timer if it does not exist.
- *
- * Side effects:
- *	See above.
- *
- * Result:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TimerSetup(
-    ReflectedTransform *rtPtr)
-{
-    if (rtPtr->timer != NULL) {
-	return;
-    }
-
-    rtPtr->timer = Tcl_CreateTimerHandler(FLUSH_DELAY, TimerRun, rtPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TimerRun --
- *
- *	Called by the notifier (-> timer) to flush out information waiting in
- *	channel buffers.
- *
- * Side effects:
- *	As of 'Tcl_NotifyChannel'.
- *
- * Result:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TimerRun(
-    ClientData clientData)
-{
-    ReflectedTransform *rtPtr = clientData;
-
-    rtPtr->timer = NULL;
-    Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ResultInit --
- *
- *	Initializes the specified buffer structure. The structure will contain
- *	valid information for an emtpy buffer.
- *
- * Side effects:
- *	See above.
- *
- * Result:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ResultInit(
-    ResultBuffer *rPtr)		/* Reference to the structure to
-				 * initialize. */
-{
-    rPtr->used = 0;
-    rPtr->allocated = 0;
-    rPtr->buf = NULL;
-}
-/*
- *----------------------------------------------------------------------
- *
- * ResultClear --
- *
- *	Deallocates any memory allocated by 'ResultAdd'.
- *
- * Side effects:
- *	See above.
- *
- * Result:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ResultClear(
-    ResultBuffer *rPtr)		/* Reference to the buffer to clear out */
-{
-    rPtr->used = 0;
-
-    if (!rPtr->allocated) {
-	return;
-    }
-
-    Tcl_Free((char *) rPtr->buf);
-    rPtr->buf = NULL;
-    rPtr->allocated = 0;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ResultAdd --
- *
- *	Adds the bytes in the specified array to the buffer, by appending it.
- *
- * Side effects:
- *	See above.
- *
- * Result:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ResultAdd(
-    ResultBuffer *rPtr,		/* The buffer to extend */
-    unsigned char *buf,		/* The buffer to read from */
-    int toWrite)		/* The number of bytes in 'buf' */
-{
-    if ((rPtr->used + toWrite + 1) > rPtr->allocated) {
-	/*
-	 * Extension of the internal buffer is required.
-	 * NOTE: Currently linear. Should be doubling to amortize.
-	 */
-
-	if (rPtr->allocated == 0) {
-	    rPtr->allocated = toWrite + RB_INCREMENT;
-	    rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated));
-	} else {
-	    rPtr->allocated += toWrite + RB_INCREMENT;
-	    rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf,
-		    rPtr->allocated));
-	}
-    }
-
-    /*
-     * Now copy data.
-     */
-
-    memcpy(rPtr->buf + rPtr->used, buf, toWrite);
-    rPtr->used += toWrite;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- * Side effects:
- *	See above.
- *
- * Result:
- *	The number of actually copied bytes, possibly less than 'toRead'.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ResultCopy(
-    ResultBuffer *rPtr,		/* The buffer to read from */
-    unsigned char *buf,		/* The buffer to copy into */
-    int toRead)			/* Number of requested bytes */
-{
-    int copied;
-
-    if (rPtr->used == 0) {
-	/*
-	 * Nothing to copy in the case of an empty buffer.
-	 */
-
-	copied = 0;
-    } else if (rPtr->used == toRead) {
-	/*
-	 * We have just enough. Copy everything to the caller.
-	 */
-
-	memcpy(buf, rPtr->buf, toRead);
-	rPtr->used = 0;
-	copied = toRead;
-    } else if (rPtr->used > toRead) {
-	/*
-	 * The internal buffer contains more than requested. Copy the
-	 * requested subset to the caller, and shift the remaining bytes down.
-	 */
-
-	memcpy(buf, rPtr->buf, toRead);
-	memmove(rPtr->buf, rPtr->buf + toRead, rPtr->used - toRead);
-
-	rPtr->used -= toRead;
-	copied = toRead;
-    } else {
-	/*
-	 * There is not enough in the buffer to satisfy the caller, so take
-	 * everything.
-	 */
-
-	memcpy(buf, rPtr->buf, rPtr->used);
-	toRead = rPtr->used;
-	rPtr->used = 0;
-	copied = toRead;
-    }
-
-    /* -- common postwork code ------- */
-
-    return copied;
-}
-
-static int
-TransformRead(
-    ReflectedTransform *rtPtr,
-    int *errorCodePtr,
-    unsigned char *buf,
-    int toRead)
-{
-    Tcl_Obj *bufObj;
-    Tcl_Obj *resObj;
-    int bytec;			/* Number of returned bytes */
-    unsigned char *bytev;	/* Array of returned bytes */
-
-    /*
-     * Are we in the correct thread?
-     */
-
-#ifdef TCL_THREADS
-    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	ForwardParam p;
-
-	p.transform.buf = (char *) buf;
-	p.transform.size = toRead;
-
-	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
-
-	if (p.base.code != TCL_OK) {
-	    PassReceivedError(rtPtr->chan, &p);
-	    *errorCodePtr = EINVAL;
-	    return 0;
-	}
-
-	*errorCodePtr = EOK;
-	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
-	ckfree(p.transform.buf);
-	return 1;
-    }
-#endif
-
-    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
-    /* ASSERT: rtPtr->mode & TCL_READABLE */
-
-    bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toRead);
-    Tcl_IncrRefCount(bufObj);
-
-    if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
-	Tcl_SetChannelError(rtPtr->chan, resObj);
-	Tcl_DecrRefCount(bufObj);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	*errorCodePtr = EINVAL;
-	return 0;
-    }
-
-    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-    ResultAdd(&rtPtr->result, bytev, bytec);
-
-    Tcl_DecrRefCount(bufObj);
-    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
-    return 1;
-}
-
-static int
-TransformWrite(
-    ReflectedTransform *rtPtr,
-    int *errorCodePtr,
-    unsigned char *buf,
-    int toWrite)
-{
-    Tcl_Obj *bufObj;
-    Tcl_Obj *resObj;
-    int bytec;			/* Number of returned bytes */
-    unsigned char *bytev;	/* Array of returned bytes */
-    int res;
-
-    /*
-     * Are we in the correct thread?
-     */
-
-#ifdef TCL_THREADS
-    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	ForwardParam p;
-
-	p.transform.buf = (char *) buf;
-	p.transform.size = toWrite;
-
-	ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
-
-	if (p.base.code != TCL_OK) {
-	    PassReceivedError(rtPtr->chan, &p);
-	    *errorCodePtr = EINVAL;
-	    return 0;
-	}
-
-	*errorCodePtr = EOK;
-	res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
-		p.transform.size);
-	ckfree(p.transform.buf);
-    } else
-#endif
-    {
-	/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
-	/* ASSERT: rtPtr->mode & TCL_WRITABLE */
-
-	bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
-	Tcl_IncrRefCount(bufObj);
-	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
-	    *errorCodePtr = EINVAL;
-	    Tcl_SetChannelError(rtPtr->chan, resObj);
-
-	    Tcl_DecrRefCount(bufObj);
-	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	    return 0;
-	}
-
-	*errorCodePtr = EOK;
-
-	bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-	res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
-
-	Tcl_DecrRefCount(bufObj);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-    }
-
-    if (res < 0) {
-	*errorCodePtr = EINVAL;
-	return 0;
-    }
-
-    return 1;
-}
-
-static int
-TransformDrain(
-    ReflectedTransform *rtPtr,
-    int *errorCodePtr)
-{
-    Tcl_Obj *resObj;
-    int bytec;			/* Number of returned bytes */
-    unsigned char *bytev;	/* Array of returned bytes */
-
-    /*
-     * Are we in the correct thread?
-     */
-
-#ifdef TCL_THREADS
-    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	ForwardParam p;
-
-	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);
-
-	if (p.base.code != TCL_OK) {
-	    PassReceivedError(rtPtr->chan, &p);
-	    *errorCodePtr = EINVAL;
-	    return 0;
-	}
-
-	*errorCodePtr = EOK;
-	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
-	ckfree(p.transform.buf);
-    } else
-#endif
-    {
-	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
-	    Tcl_SetChannelError(rtPtr->chan, resObj);
-	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	    *errorCodePtr = EINVAL;
-	    return 0;
-	}
-
-	bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-	ResultAdd(&rtPtr->result, bytev, bytec);
-
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-    }
-
-    rtPtr->readIsDrained = 1;
-    return 1;
-}
-
-static int
-TransformFlush(
-    ReflectedTransform *rtPtr,
-    int *errorCodePtr,
-    int op)
-{
-    Tcl_Obj *resObj;
-    int bytec;			/* Number of returned bytes */
-    unsigned char *bytev;	/* Array of returned bytes */
-    int res;
-
-    /*
-     * Are we in the correct thread?
-     */
-
-#ifdef TCL_THREADS
-    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	ForwardParam p;
-
-	ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);
-
-	if (p.base.code != TCL_OK) {
-	    PassReceivedError(rtPtr->chan, &p);
-	    *errorCodePtr = EINVAL;
-	    return 0;
-	}
-
-	*errorCodePtr = EOK;
-	if (op == FLUSH_WRITE) {
-	    res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
-		    p.transform.size);
-	} else {
-	    res = 0;
-	}
-	ckfree(p.transform.buf);
-    } else
-#endif
-    {
-	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
-	    Tcl_SetChannelError(rtPtr->chan, resObj);
-	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	    *errorCodePtr = EINVAL;
-	    return 0;
-	}
-
-	if (op == FLUSH_WRITE) {
-	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
-	    res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
-	} else {
-	    res = 0;
-	}
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-    }
-
-    if (res < 0) {
-	*errorCodePtr = EINVAL;
-	return 0;
-    }
-
-    return 1;
-}
-
-static void
-TransformClear(
-    ReflectedTransform *rtPtr)
-{
-    /*
-     * Are we in the correct thread?
-     */
-
-#ifdef TCL_THREADS
-    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	ForwardParam p;
-
-	ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
-	return;
-    }
-#endif
-
-    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
-    /* ASSERT: rtPtr->mode & TCL_READABLE */
-
-    (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
-
-    rtPtr->readIsDrained = 0;
-    ResultClear(&rtPtr->result);
-}
-
-static int
-TransformLimit(
-    ReflectedTransform *rtPtr,
-    int *errorCodePtr,
-    int *maxPtr)
-{
-    Tcl_Obj *resObj;
-    Tcl_InterpState sr;		/* State of handler interp */
-
-    /*
-     * Are we in the correct thread?
-     */
-
-#ifdef TCL_THREADS
-    if (rtPtr->thread != Tcl_GetCurrentThread()) {
-	ForwardParam p;
-
-	ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);
-
-	if (p.base.code != TCL_OK) {
-	    PassReceivedError(rtPtr->chan, &p);
-	    *errorCodePtr = EINVAL;
-	    return 0;
-	}
-
-	*errorCodePtr = EOK;
-	*maxPtr = p.limit.max;
-	return 1;
-    }
-#endif
-
-    /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
-    /* ASSERT: rtPtr->mode & TCL_WRITABLE */
-
-    if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
-	Tcl_SetChannelError(rtPtr->chan, resObj);
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	*errorCodePtr = EINVAL;
-	return 0;
-    }
-
-    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
-
-    if (Tcl_GetIntFromObj(rtPtr->interp, resObj, maxPtr) != TCL_OK) {
-	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
-	Tcl_SetChannelError(rtPtr->chan, MarshallError(rtPtr->interp));
-	*errorCodePtr = EINVAL;
-
-	Tcl_RestoreInterpState(rtPtr->interp, sr);
-	return 0;
-    }
-
-    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
-    Tcl_RestoreInterpState(rtPtr->interp, sr);
-    return 1;
-}
-
-/* DUPLICATE of HaveVersion() in tclIO.c
- *----------------------------------------------------------------------
- *
- * HaveVersion --
- *
- *	Return whether a channel type is (at least) of a given version.
- *
- * Results:
- *	True if the minimum version is exceeded by the version actually
- *	present.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-HaveVersion(
-    const Tcl_ChannelType *chanTypePtr,
-    Tcl_ChannelTypeVersion minimumVersion)
-{
-    Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);
-
-    return PTR2INT(actualVersion) >= PTR2INT(minimumVersion);
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 7b7b647..159f3da 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -1,34 +1,30 @@
-/*
+/* 
  * 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"
-
-#if defined(_WIN32) && defined(UNICODE)
-/* On Windows, we always need the ASCII version. */
-#   undef gai_strerror
-#   define gai_strerror gai_strerrorA
-#endif
+#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.
@@ -37,21 +33,21 @@
  */
 
 int
-TclSockGetPort(
-    Tcl_Interp *interp,
-    const char *string, /* Integer or service name */
-    const char *proto, /* "tcp" or "udp", typically */
-    int *portPtr)		/* Return port number */
+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 */
 {
     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);
@@ -64,8 +60,8 @@ TclSockGetPort(
 	return TCL_ERROR;
     }
     if (*portPtr > 0xFFFF) {
-	Tcl_AppendResult(interp, "couldn't open socket: port number too high",
-		NULL);
+        Tcl_AppendResult(interp, "couldn't open socket: port number too high",
+                (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -87,14 +83,15 @@ TclSockGetPort(
  *----------------------------------------------------------------------
  */
 
+#undef TclSockMinimumBuffers
 #ifndef _WIN32
-#   define SOCKET size_t
+#   define SOCKET int
 #endif
 
 int
-TclSockMinimumBuffers(
-    void *sock,			/* Socket file descriptor */
-    int size)			/* Minimum buffer size */
+TclSockMinimumBuffers(sock, size)
+    void *sock;			/* Socket file descriptor */
+    int size;			/* Minimum buffer size */
 {
     int current;
     socklen_t len;
@@ -113,175 +110,3 @@ TclSockMinimumBuffers(
     }
     return TCL_OK;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclCreateSocketAddress --
- *
- *	This function initializes a sockaddr structure for a host and port.
- *
- * Results:
- *	1 if the host was valid, 0 if the host could not be converted to an IP
- *	address.
- *
- * Side effects:
- *	Fills in the *sockaddrPtr structure.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCreateSocketAddress(
-    Tcl_Interp *interp,                 /* Interpreter for querying
-					 * the desired socket family */
-    struct addrinfo **addrlist,		/* Socket address list */
-    const char *host,			/* Host. NULL implies INADDR_ANY */
-    int port,				/* Port number */
-    int willBind,			/* Is this an address to bind() to or
-					 * to connect() to? */
-    const char **errorMsgPtr)		/* Place to store the error message
-					 * detail, if available. */
-{
-    struct addrinfo hints;
-    struct addrinfo *p;
-    struct addrinfo *v4head = NULL, *v4ptr = NULL;
-    struct addrinfo *v6head = NULL, *v6ptr = NULL;
-    char *native = NULL, portstring[TCL_INTEGER_SPACE];
-    const char *family = NULL;
-    Tcl_DString ds;
-    int result, i;
-
-    TclFormatInt(portstring, port);
-
-    if (host != NULL) {
-	native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
-    }
-    
-    (void) memset(&hints, 0, sizeof(hints));
-    
-    hints.ai_family = AF_UNSPEC;
-    /* 
-     * Magic variable to enforce a certain address family - to be superseded
-     * by a TIP that adds explicit switches to [socket]
-     */
-    if (interp != NULL) {
-        family = Tcl_GetVar(interp, "::tcl::unsupported::socketAF", 0);
-        if (family != NULL) {
-            if (strcmp(family, "inet") == 0) {
-                hints.ai_family = AF_INET;
-            } else if (strcmp(family, "inet6") == 0) {
-                hints.ai_family = AF_INET6;
-            }
-        }
-    }
-
-    hints.ai_socktype = SOCK_STREAM;
-
-#if 0
-    /*
-     * We found some problems when using AI_ADDRCONFIG, e.g. on systems that
-     * have no networking besides the loopback interface and want to resolve
-     * localhost. See bugs 3385024, 3382419, 3382431. As the advantage of
-     * using AI_ADDRCONFIG in situations where it works, is probably low,
-     * we'll leave it out for now. After all, it is just an optimisation.
-     *
-     * Missing on: OpenBSD, NetBSD.
-     * Causes failure when used on AIX 5.1 and HP-UX
-     */
-
-#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
-    hints.ai_flags |= AI_ADDRCONFIG;
-#endif /* AI_ADDRCONFIG && !_AIX && !__hpux */
-#endif /* 0 */
-
-    if (willBind) {
-	hints.ai_flags |= AI_PASSIVE;
-    } 
-
-    result = getaddrinfo(native, portstring, &hints, addrlist);
-
-    if (host != NULL) {
-	Tcl_DStringFree(&ds);
-    }
-
-    if (result != 0) {
-	goto error;
-    }
-
-    /*
-     * Put IPv4 addresses before IPv6 addresses to maximize backwards
-     * compatibility of [fconfigure -sockname] output.
-     *
-     * There might be more elegant/efficient ways to do this.
-     */
-    if (willBind) {
-	for (p = *addrlist; p != NULL; p = p->ai_next) {
-	    if (p->ai_family == AF_INET) {
-		if (v4head == NULL) {
-		    v4head = p;
-		} else {
-		    v4ptr->ai_next = p;
-		}
-		v4ptr = p;
-	    } else {
-		if (v6head == NULL) {
-		    v6head = p;
-		} else {
-		    v6ptr->ai_next = p;
-		}
-		v6ptr = p;
-	    }
-	}
-	*addrlist = NULL;
-	if (v6head != NULL) {
-	    *addrlist = v6head;
-	    v6ptr->ai_next = NULL;
-	}
-	if (v4head != NULL) {
-	    v4ptr->ai_next = *addrlist;
-	    *addrlist = v4head;
-	}
-    }
-    i = 0;
-    for (p = *addrlist; p != NULL; p = p->ai_next) {
-	i++;
-    }
-    
-    return 1;
-	
-    /*
-     * Ought to use gai_strerror() here...
-     */
-
-error:
-    switch (result) {
-    case EAI_NONAME:
-    case EAI_SERVICE:
-#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
-    case EAI_ADDRFAMILY:
-#endif
-#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
-    case EAI_NODATA:
-#endif
-	*errorMsgPtr = gai_strerror(result);
-	errno = EHOSTUNREACH;
-	return 0;
-#ifdef EAI_SYSTEM
-    case EAI_SYSTEM:
-	return 0;
-#endif
-    default:
-	*errorMsgPtr = gai_strerror(result);
-	errno = ENXIO;
-	return 0;
-    }
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index c4e7db0..d50f2e3 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -1,229 +1,140 @@
-/*
+/* 
  * 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.
  */
 
-#if defined(HAVE_SYS_STAT_H) && !defined _WIN32
-#   include <sys/stat.h>
+#ifndef _WIN64
+/* See [Bug 2935503]: file mtime sets wrong time */
+#   define _USE_32BIT_TIME_T
 #endif
+
+#include <sys/stat.h>
 #include "tclInt.h"
+#include "tclPort.h"
+#ifdef MAC_TCL
+#include "tclMacInt.h"
+#endif
 #ifdef __WIN32__
-#   include "tclWinInt.h"
+/* for tclWinProcs->useWide */
+#include "tclWinInt.h"
 #endif
-#include "tclFileSystem.h"
 
-/*
- * Prototypes for functions defined later in this file.
+/* 
+ * 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.
  */
-
-static int		EvalFileCallback(ClientData data[],
-			    Tcl_Interp *interp, int result);
-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 *		DivertFindSymbol(Tcl_Interp *interp,
-			    Tcl_LoadHandle loadHandle, const char *symbol);
-static void		DivertUnloadFile(Tcl_LoadHandle loadHandle);
-
-/*
- * 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.
+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. */
+} 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.
  */
 
-MODULE_SCOPE const char *const		tclpFileAttrStrings[];
-MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];
-
-/*
- * 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.
+int      TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr));
+int	 TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp, 
+		Tcl_Obj *objPtr, ClientData clientData));
+int      TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp, 
+		Tcl_Obj *pathPtr, int startAt, ClientData *clientDataPtr));
+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;
 
-static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
-static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
-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) 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).
+/* 
+ * Private functions for use in this file
  */
-
-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!
- */
-
-const Tcl_Filesystem tclNativeFilesystem = {
-    "native",
-    sizeof(Tcl_Filesystem),
-    TCL_FILESYSTEM_VERSION_2,
-    TclNativePathInFilesystem,
-    TclNativeDupInternalRep,
-    NativeFreeInternalRep,
-    TclpNativeToNormalized,
-    TclNativeCreateNativeRep,
-    TclpObjNormalizePath,
-    TclpFilesystemPathType,
-    NativeFilesystemSeparator,
-    TclpObjStat,
-    TclpObjAccess,
-    TclpOpenFileChannel,
-    TclpMatchInDirectory,
-    TclpUtime,
-#ifndef S_IFLNK
-    NULL,
-#else
-    TclpObjLink,
-#endif /* S_IFLNK */
-    TclpObjListVolumes,
-    NativeFileAttrStrings,
-    NativeFileAttrsGet,
-    NativeFileAttrsSet,
-    TclpObjCreateDirectory,
-    TclpObjRemoveDirectory,
-    TclpObjDeleteFile,
-    TclpObjCopyFile,
-    TclpObjRenameFile,
-    TclpObjCopyDirectory,
-    TclpObjLstat,
-    TclpDlopen,
-    /* 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.
- */
-
-static FilesystemRecord nativeFilesystemRecord = {
-    NULL,
-    &tclNativeFilesystem,
-    1,
-    NULL,
-    NULL
-};
-
+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,
+					 ClientData *clientDataPtr));
 /*
- * 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.
+ * Prototypes for procedures defined later in this file.
  */
 
-static int theFilesystemEpoch = 0;
+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));
 
-/*
- * 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;
-TCL_DECLARE_MUTEX(filesystemMutex)
+#ifdef TCL_THREADS
+static void FsRecacheFilesystemList(void);
+#endif
 
-/*
- * Used to implement Tcl_FSGetCwd in a file-system independent way.
+/* 
+ * 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.
  */
+extern CONST char *		tclpFileAttrStrings[];
+extern CONST TclFileAttrProcs	tclpFileAttrProcs[];
 
-static Tcl_Obj *cwdPathPtr = NULL;
-static int cwdPathEpoch = 0;
-static ClientData cwdClientData = NULL;
-TCL_DECLARE_MUTEX(cwdMutex)
-
-Tcl_ThreadDataKey tclFsDataKey;
-
-/*
- * 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.
+/* 
+ * The following functions are obsolete string based APIs, and should
+ * be removed in a future release (Tcl 9 would be a good time).
  */
-
-typedef struct FsDivertLoad {
-    Tcl_LoadHandle loadHandle;
-    Tcl_FSUnloadFileProc *unloadProcPtr;
-    Tcl_Obj *divertedFile;
-    const Tcl_Filesystem *divertedFilesystem;
-    ClientData divertedFileNativeRep;
-} FsDivertLoad;
 
-/*
- * 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(
-    const char *path,		/* Path of file to stat (in current CP). */
-    struct stat *oldStyleBuf)	/* Filled with results of stat call. */
+Tcl_Stat(path, oldStyleBuf)
+    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;
@@ -234,37 +145,42 @@ Tcl_Stat(
     Tcl_DecrRefCount(pathPtr);
     if (ret != -1) {
 #ifndef TCL_WIDE_INT_IS_LONG
-	Tcl_WideInt tmp1, tmp2, tmp3 = 0;
-
-# define OUT_OF_RANGE(x) \
+#   define OUT_OF_RANGE(x) \
 	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
 	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
-# define OUT_OF_URANGE(x) \
-	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_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
 
 	/*
 	 * 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.
 	 */
 
-	tmp1 = (Tcl_WideInt) buf.st_ino;
-	tmp2 = (Tcl_WideInt) buf.st_size;
-#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
-	tmp3 = (Tcl_WideInt) buf.st_blocks;
+        if (OUT_OF_URANGE(buf.st_ino) || OUT_OF_RANGE(buf.st_size)
+#ifdef HAVE_ST_BLOCKS
+		|| OUT_OF_RANGE(buf.st_blocks)
 #endif
-
-	if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) {
-#if defined(EFBIG)
+	    ) {
+#ifdef EFBIG
 	    errno = EFBIG;
-#elif defined(EOVERFLOW)
-	    errno = EOVERFLOW;
 #else
-#error "What status should be returned for file size out of range?"
+#  ifdef EOVERFLOW
+	    errno = EOVERFLOW;
+#  else
+#    error  "What status should be returned for file size out of range?"
+#  endif
 #endif
 	    return -1;
 	}
@@ -274,33 +190,27 @@ Tcl_Stat(
 #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_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
+	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;
 #endif
     }
     return ret;
@@ -308,45 +218,43 @@ Tcl_Stat(
 
 /* Obsolete */
 int
-Tcl_Access(
-    const char *path,		/* Path of file to access (in current CP). */
-    int mode)			/* Permission setting. */
+Tcl_Access(path, mode)
+    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(
-    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(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_Channel ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
-
     Tcl_IncrRefCount(pathPtr);
     ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
     Tcl_DecrRefCount(pathPtr);
-
     return ret;
+
 }
 
 /* Obsolete */
 int
-Tcl_Chdir(
-    const char *dirName)
+Tcl_Chdir(dirName)
+    CONST char *dirName;
 {
     int ret;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
@@ -358,212 +266,372 @@ Tcl_Chdir(
 
 /* Obsolete */
 char *
-Tcl_GetCwd(
-    Tcl_Interp *interp,
-    Tcl_DString *cwdPtr)
+Tcl_GetCwd(interp, cwdPtr)
+    Tcl_Interp *interp;
+    Tcl_DString *cwdPtr;
 {
-    Tcl_Obj *cwd = Tcl_FSGetCwd(interp);
-
+    Tcl_Obj *cwd;
+    cwd = Tcl_FSGetCwd(interp);
     if (cwd == NULL) {
 	return NULL;
+    } else {
+	Tcl_DStringInit(cwdPtr);
+	Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
+	Tcl_DecrRefCount(cwd);
+	return Tcl_DStringValue(cwdPtr);
     }
-    Tcl_DStringInit(cwdPtr);
-    Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
-    Tcl_DecrRefCount(cwd);
-    return Tcl_DStringValue(cwdPtr);
 }
 
 /* Obsolete */
 int
-Tcl_EvalFile(
-    Tcl_Interp *interp,		/* Interpreter in which to process file. */
-    const char *fileName)	/* Name of file to process. Tilde-substitution
+Tcl_EvalFile(interp, fileName)
+    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;
     Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
-
     Tcl_IncrRefCount(pathPtr);
     ret = Tcl_FSEvalFile(interp, pathPtr);
     Tcl_DecrRefCount(pathPtr);
     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.
+ */
+#define USE_OBSOLETE_FS_HOOKS
+
+
+#ifdef USE_OBSOLETE_FS_HOOKS
 /*
- * Now move on to the basic filesystem implementation.
+ * 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 */
+} StatProc;
+
+typedef struct AccessProc {
+    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 */
+    struct OpenFileChannelProc *nextPtr;
+				    /* 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.
+ *
+ * This method avoids the need to call any sort of "initialization"
+ * function.
+ *
+ * All three lists are protected by a global obsoleteFsHookMutex.
+ */
+
+static StatProc *statProcList = NULL;
+static AccessProc *accessProcList = NULL;
+static OpenFileChannelProc *openFileChannelProcList = NULL;
+
+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.
+ */
+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).
+ */
+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_Filesystem tclNativeFilesystem = {
+    "native",
+    sizeof(Tcl_Filesystem),
+    TCL_FILESYSTEM_VERSION_1,
+    &NativePathInFilesystem,
+    &TclNativeDupInternalRep,
+    &NativeFreeInternalRep,
+    &TclpNativeToNormalized,
+    &NativeCreateNativeRep,
+    &TclpObjNormalizePath,
+    &TclpFilesystemPathType,
+    &NativeFilesystemSeparator,
+    &TclpObjStat,
+    &TclpObjAccess,
+    &TclpOpenFileChannel,
+    &TclpMatchInDirectory,
+    &TclpUtime,
+#ifndef S_IFLNK
+    NULL,
+#else
+    &TclpObjLink,
+#endif /* S_IFLNK */
+    &TclpObjListVolumes,
+    &NativeFileAttrStrings,
+    &NativeFileAttrsGet,
+    &NativeFileAttrsSet,
+    &TclpObjCreateDirectory,
+    &TclpObjRemoveDirectory, 
+    &TclpObjDeleteFile,
+    &TclpObjCopyFile,
+    &TclpObjRenameFile,
+    &TclpObjCopyDirectory, 
+    &TclpObjLstat,
+    &TclpDlopen,
+    &TclpObjGetCwd,
+    &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.
+ */
+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.  
+ */
+int theFilesystemEpoch = 0;
+
+/*
+ * 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;
+
+TCL_DECLARE_MUTEX(filesystemMutex)
+
+/* 
+ * Used to implement Tcl_FSGetCwd in a file-system independent way.
+ */
+static Tcl_Obj* cwdPathPtr = NULL;
+static int cwdPathEpoch = 0;
+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;
+
+/*
+ * 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_Obj *divertedFile;
+    Tcl_Filesystem *divertedFilesystem;
+    ClientData divertedFileNativeRep;
+} FsDivertLoad;
+
+/* Now move on to the basic filesystem implementation */
+
 static void
-FsThrExitProc(
-    ClientData cd)
+FsThrExitProc(cd)
+    ClientData cd;
 {
-    ThreadSpecificData *tsdPtr = 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;
     }
-    if (tsdPtr->cwdClientData != NULL) {
-	NativeFreeInternalRep(tsdPtr->cwdClientData);
-    }
-
-    /*
-     * Trash the filesystems cache.
-     */
-
+    /* Trash the filesystems cache */
     fsRecPtr = tsdPtr->filesystemList;
     while (fsRecPtr != NULL) {
 	tmpFsRecPtr = fsRecPtr->nextPtr;
 	if (--fsRecPtr->fileRefCount <= 0) {
-	    ckfree(fsRecPtr);
+	    ckfree((char *)fsRecPtr);
 	}
 	fsRecPtr = tmpFsRecPtr;
     }
     tsdPtr->initialized = 0;
 }
 
-int
-TclFSCwdIsNative(void)
+int 
+TclFSCwdPointerEquals(objPtr)
+    Tcl_Obj* objPtr;
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
-    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(&tclFsDataKey);
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     Tcl_MutexLock(&cwdMutex);
-    if (tsdPtr->cwdPathPtr == NULL
-	    || tsdPtr->cwdPathEpoch != cwdPathEpoch) {
-	if (tsdPtr->cwdPathPtr != NULL) {
-	    Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
-	}
-	if (tsdPtr->cwdClientData != NULL) {
-	    NativeFreeInternalRep(tsdPtr->cwdClientData);
-	}
+    if (tsdPtr->cwdPathPtr == NULL) {
 	if (cwdPathPtr == NULL) {
 	    tsdPtr->cwdPathPtr = NULL;
 	} else {
 	    tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
 	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
 	}
-	if (cwdClientData == NULL) {
-	    tsdPtr->cwdClientData = NULL;
+	tsdPtr->cwdPathEpoch = cwdPathEpoch;
+    } else if (tsdPtr->cwdPathEpoch != cwdPathEpoch) { 
+	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
+	if (cwdPathPtr == NULL) {
+	    tsdPtr->cwdPathPtr = NULL;
 	} else {
-	    tsdPtr->cwdClientData = TclNativeDupInternalRep(cwdClientData);
+	    tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
+	    Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
 	}
-	tsdPtr->cwdPathEpoch = cwdPathEpoch;
     }
     Tcl_MutexUnlock(&cwdMutex);
 
     if (tsdPtr->initialized == 0) {
-	Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
+	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
 	tsdPtr->initialized = 1;
     }
-
-    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) && !memcmp(str1, str2, len1)) {
-	    /*
-	     * 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;
-	}
-    }
+    return (tsdPtr->cwdPathPtr == objPtr); 
 }
-
 #ifdef TCL_THREADS
+
 static void
 FsRecacheFilesystemList(void)
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL;
 
-    /*
-     * Trash the current cache.
-     */
-
+    /* Trash the current cache */
     fsRecPtr = tsdPtr->filesystemList;
     while (fsRecPtr != NULL) {
 	tmpFsRecPtr = fsRecPtr->nextPtr;
 	if (--fsRecPtr->fileRefCount <= 0) {
-	    ckfree(fsRecPtr);
+	    ckfree((char *)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.
+     * 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 */
     fsRecPtr = filesystemList;
     while (fsRecPtr != NULL) {
 	tmpFsRecPtr = fsRecPtr;
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-
-    /*
-     * Refill the cache honouring the order.
-     */
-
+    
+    /* Refill the cache honouring the order */
     fsRecPtr = tmpFsRecPtr;
     while (fsRecPtr != NULL) {
-	tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord));
+	tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));
 	*tmpFsRecPtr = *fsRecPtr;
 	tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
 	tmpFsRecPtr->prevPtr = NULL;
@@ -571,26 +639,21 @@ FsRecacheFilesystemList(void)
 	    tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;
 	}
 	tsdPtr->filesystemList = tmpFsRecPtr;
-	fsRecPtr = fsRecPtr->prevPtr;
+        fsRecPtr = fsRecPtr->prevPtr;
     }
 
-    /*
-     * 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, tsdPtr);
+	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
 	tsdPtr->initialized = 1;
     }
 }
-#endif /* TCL_THREADS */
+#endif
 
 static FilesystemRecord *
-FsGetFirstFilesystem(void)
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+FsGetFirstFilesystem(void) {
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     FilesystemRecord *fsRecPtr;
-
 #ifndef TCL_THREADS
     tsdPtr->filesystemEpoch = theFilesystemEpoch;
     fsRecPtr = filesystemList;
@@ -598,7 +661,7 @@ FsGetFirstFilesystem(void)
     Tcl_MutexLock(&filesystemMutex);
     if (tsdPtr->filesystemList == NULL
 	    || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
-	FsRecacheFilesystemList();
+ 	FsRecacheFilesystemList();
 	tsdPtr->filesystemEpoch = theFilesystemEpoch;
     }
     Tcl_MutexUnlock(&filesystemMutex);
@@ -607,33 +670,13 @@ FsGetFirstFilesystem(void)
     return fsRecPtr;
 }
 
-/*
- * The epoch can be changed both by filesystems being added or removed and by
- * env(HOME) changing.
- */
-
-int
-TclFSEpochOk(
-    int filesystemEpoch)
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
-    (void) FsGetFirstFilesystem();
-    return (filesystemEpoch == tsdPtr->filesystemEpoch);
-}
-
-/*
- * If non-NULL, clientData is owned by us and must be freed later.
- */
-
 static void
-FsUpdateCwd(
-    Tcl_Obj *cwdObj,
-    ClientData clientData)
+FsUpdateCwd(cwdObj)
+    Tcl_Obj *cwdObj;
 {
     int len;
-    const char *str = NULL;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
+    char *str = NULL;
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (cwdObj != NULL) {
 	str = Tcl_GetStringFromObj(cwdObj, &len);
@@ -641,42 +684,26 @@ FsUpdateCwd(
 
     Tcl_MutexLock(&cwdMutex);
     if (cwdPathPtr != NULL) {
-	Tcl_DecrRefCount(cwdPathPtr);
-    }
-    if (cwdClientData != NULL) {
-	NativeFreeInternalRep(cwdClientData);
+        Tcl_DecrRefCount(cwdPathPtr);
     }
-
     if (cwdObj == NULL) {
 	cwdPathPtr = NULL;
-	cwdClientData = NULL;
     } else {
-	/*
-	 * This must be stored as string obj!
-	 */
-
-	cwdPathPtr = Tcl_NewStringObj(str, len);
-	Tcl_IncrRefCount(cwdPathPtr);
-	cwdClientData = TclNativeDupInternalRep(clientData);
+	/* This MUST be stored as string object! */
+	cwdPathPtr = Tcl_NewStringObj(str, len); 
+    	Tcl_IncrRefCount(cwdPathPtr);
     }
-
     cwdPathEpoch++;
     tsdPtr->cwdPathEpoch = cwdPathEpoch;
     Tcl_MutexUnlock(&cwdMutex);
 
     if (tsdPtr->cwdPathPtr) {
-	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
-    }
-    if (tsdPtr->cwdClientData) {
-	NativeFreeInternalRep(tsdPtr->cwdClientData);
+        Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
     }
-
     if (cwdObj == NULL) {
 	tsdPtr->cwdPathPtr = NULL;
-	tsdPtr->cwdClientData = NULL;
     } else {
-	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len);
-	tsdPtr->cwdClientData = clientData;
+	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len); 
 	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
     }
 }
@@ -686,12 +713,12 @@ FsUpdateCwd(
  *
  * 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.
  *
@@ -702,41 +729,33 @@ FsUpdateCwd(
  */
 
 void
-TclFinalizeFilesystem(void)
+TclFinalizeFilesystem()
 {
     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;
-    }
-    if (cwdClientData != NULL) {
-	NativeFreeInternalRep(cwdClientData);
-	cwdClientData = NULL;
+        cwdPathEpoch = 0;
     }
 
-    /*
-     * 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.
-	     */
-
+	    /* The native filesystem is static, so we don't free it */
 	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
-		ckfree(fsRecPtr);
+		ckfree((char *)fsRecPtr);
 	    }
 	}
 	fsRecPtr = tmpFsRecPtr;
@@ -744,10 +763,13 @@ TclFinalizeFilesystem(void)
     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.
      */
 
+    statProcList = NULL;
+    accessProcList = NULL;
+    openFileChannelProcList = NULL;
 #ifdef __WIN32__
     TclWinEncodingsCleanup();
 #endif
@@ -759,7 +781,7 @@ TclFinalizeFilesystem(void)
  * TclResetFilesystem --
  *
  *	Restore the filesystem to a pristine state.
- *
+ *	
  * Results:
  *	None.
  *
@@ -770,21 +792,22 @@ TclFinalizeFilesystem(void)
  */
 
 void
-TclResetFilesystem(void)
+TclResetFilesystem()
 {
     filesystemList = &nativeFilesystemRecord;
 
-    /*
-     * Note, at this point, I believe nativeFilesystemRecord -> fileRefCount
-     * should equal 1 and if not, we should try to track down the cause.
+    /* 
+     * 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
 }
@@ -794,35 +817,36 @@ TclResetFilesystem(void)
  *
  * 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 clientData,	/* Client specific data for this fs. */
-    const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */
+Tcl_FSRegister(clientData, fsPtr)
+    ClientData clientData;    /* Client specific data for this fs */
+    Tcl_Filesystem  *fsPtr;   /* The filesystem record for the new fs. */
 {
     FilesystemRecord *newFilesystemPtr;
 
@@ -830,31 +854,29 @@ Tcl_FSRegister(
 	return TCL_ERROR;
     }
 
-    newFilesystemPtr = ckalloc(sizeof(FilesystemRecord));
+    newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
 
     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.
+    /* 
+     * 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;
@@ -864,11 +886,10 @@ Tcl_FSRegister(
     }
     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);
 
@@ -880,28 +901,29 @@ Tcl_FSRegister(
  *
  * 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 function pointer was successfully removed, TCL_ERROR
- *	otherwise.
+ *    TCL_OK if the procedure 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(
-    const Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
+Tcl_FSUnregister(fsPtr)
+    Tcl_Filesystem  *fsPtr;   /* The filesystem record to remove. */
 {
     int retVal = TCL_ERROR;
     FilesystemRecord *fsRecPtr;
@@ -909,9 +931,9 @@ Tcl_FSUnregister(
     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;
@@ -925,20 +947,19 @@ Tcl_FSUnregister(
 	    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(fsRecPtr);
+	        ckfree((char *)fsRecPtr);
 	    }
 
 	    retVal = TCL_OK;
@@ -948,7 +969,7 @@ Tcl_FSUnregister(
     }
 
     Tcl_MutexUnlock(&filesystemMutex);
-    return retVal;
+    return (retVal);
 }
 
 /*
@@ -956,145 +977,132 @@ Tcl_FSUnregister(
  *
  * 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 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.
+ *	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.
+ *	
  *	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(
-    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.
+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.
 				 * May be NULL. In particular the directory
 				 * flag is very important. */
 {
-    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.
-     */
-
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
-	if (fsPtr->matchInDirectoryProc == NULL) {
-	    Tcl_SetErrno(ENOENT);
-	    return -1;
+	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;
 	}
-	ret = fsPtr->matchInDirectoryProc(interp, resultPtr, pathPtr, pattern,
-		types);
-	if (ret == TCL_OK && pattern != NULL) {
-	    FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types);
+    } 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;
+	    }
 	}
-	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);
+	/* 
+	 * 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 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));
+	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);
 	    }
 	}
-	TclDecrRefCount(tmpResultPtr);
+	Tcl_DecrRefCount(cwd);
+	return ret;
     }
-    Tcl_DecrRefCount(cwd);
-    return ret;
+    Tcl_SetErrno(ENOENT);
+    return -1;
 }
 
 /*
@@ -1102,104 +1110,85 @@ Tcl_FSMatchInDirectory(
  *
  * 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:
- *	None.
+ *	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.
  *
  * Side effects:
- *	Modifies the resultPtr.
+ *	None.
  *
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------- 
  */
-
-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. */
+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;
 {
     int mLength, gLength, i;
     int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
     Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
 
-    if (mounts == NULL) {
-	return;
-    }
+    if (mounts == NULL) return result; 
 
     if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) {
 	goto endOfMounts;
     }
-    if (Tcl_ListObjLength(NULL, resultPtr, &gLength) != TCL_OK) {
+    if (Tcl_ListObjLength(NULL, result, &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, resultPtr, j, &gElt);
+	    Tcl_ListObjIndex(NULL, result, j, &gElt);
 	    if (Tcl_FSEqualPaths(mElt, gElt)) {
 		found = 1;
 		if (!dir) {
-		    /*
-		     * We don't want to list this.
-		     */
-
-		    Tcl_ListObjReplace(NULL, resultPtr, j, 1, 0, NULL);
+		    /* 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);
 		    gLength--;
 		}
-		break;		/* Break out of for loop. */
+		/* Break out of for loop */
+		break;
 	    }
 	}
 	if (!found && dir) {
-	    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);
+	    if (Tcl_IsShared(result)) {
+		Tcl_Obj *newList;
+		newList = Tcl_DuplicateObj(result);
+		Tcl_DecrRefCount(result);
+		result = newList;
 	    }
-	    /*
-	     * No need to increment gLength, since we don't want to compare
-	     * mounts against mounts.
+	    Tcl_ListObjAppendElement(NULL, result, mElt);
+	    /* 
+	     * No need to increment gLength, since we
+	     * don't want to compare mounts against
+	     * mounts.
 	     */
 	}
     }
-
   endOfMounts:
     Tcl_DecrRefCount(mounts);
+    return result;
 }
 
 /*
@@ -1207,65 +1196,65 @@ FsAddMountsToGlobResult(
  *
  * 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(
-    const Tcl_Filesystem *fsPtr)
+Tcl_FSMountsChanged(fsPtr)
+    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);
@@ -1276,31 +1265,31 @@ Tcl_FSMountsChanged(
  *
  * 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(
-    const Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
+Tcl_FSData(fsPtr)
+    Tcl_Filesystem  *fsPtr;   /* The filesystem record to query. */
 {
     ClientData retVal = NULL;
     FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
 
     /*
-     * Traverse the list of filesystems look for a particular one. If found,
-     * return that filesystem's clientData (originally provided when calling
-     * Tcl_FSRegister).
+     * 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.
      */
 
     while ((retVal == NULL) && (fsRecPtr != NULL)) {
@@ -1316,135 +1305,219 @@ Tcl_FSData(
 /*
  *---------------------------------------------------------------------------
  *
- * TclFSNormalizeToUniquePath --
+ * TclFSNormalizeAbsolutePath --
  *
- *	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).
+ * 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 pathPtr is modified in place. The return value is the last byte
- *	offset which was recognised in the path string.
+ *	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 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.
- *
- *	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).
+ * 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.
  *
  *---------------------------------------------------------------------------
  */
-
-int
-TclFSNormalizeToUniquePath(
-    Tcl_Interp *interp,		/* Used for error messages. */
-    Tcl_Obj *pathPtr,		/* The path to normalize in place. */
-    int startAt,		/* Start at this char-offset. */
-    ClientData *clientDataPtr)	/* If we generated a complete normalized path
-				 * for a given filesystem, we can optionally
-				 * return an fs-specific clientdata here. */
+static Tcl_Obj *
+TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
+    Tcl_Interp* interp;    /* Interpreter to use */
+    Tcl_Obj *pathPtr;      /* Absolute path to normalize */
+    ClientData *clientDataPtr;
 {
-    FilesystemRecord *fsRecPtr, *firstFsRecPtr;
-    /* Ignore this variable */
-    (void) clientDataPtr;
+    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);
 
-    /*
-     * 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).
+    /* 
+     * 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.
      */
-
-    firstFsRecPtr = FsGetFirstFilesystem();
-
-    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
-	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
-	    continue;
-	}
-
-	/*
-	 * TODO: Assume that we always find the native file system; it should
-	 * always be there...
-	 */
-
-	if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
-	    startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
-		    startAt);
+    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++;
 	}
-	break;
     }
-
-    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
-	/*
-	 * Skip the native system next time through.
+    if (nplen > 0) {
+	ClientData clientData = NULL;
+	
+	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.
 	 */
-
-	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
-	    continue;
-	}
-
-	if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
-	    startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
-		    startAt);
-	}
-
-	/*
-	 * We could add an efficiency check like this:
-	 *		if (retVal == length-of(pathPtr)) {break;}
-	 * but there's not much benefit.
+	Tcl_IncrRefCount(retVal);
+	TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);
+	/* 
+	 * Since we know it is a normalized path, we can
+	 * actually convert this object into an "path" object for
+	 * greater efficiency 
 	 */
+	TclFSMakePathFromNormalized(interp, retVal, clientData);
+	if (clientDataPtr != NULL) {
+	    *clientDataPtr = clientData;
+	}
+    } 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);
 
-    return startAt;
+    /* This has a refCount of 1 for the caller */
+    return retVal;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * TclGetOpenMode --
+ * TclFSNormalizeToUniquePath --
  *
- *	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.
+ * 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).
  *
  * Results:
- *	Same as TclGetOpenModeEx().
+ *	The pathPtr is modified in place.  The return value is
+ *	the last byte offset which was recognised in the path
+ *	string.
  *
  * Side effects:
- *	Same as TclGetOpenModeEx().
+ *	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).
  *---------------------------------------------------------------------------
  */
-
 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. */
+TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
+    Tcl_Interp *interp;
+    Tcl_Obj *pathPtr;
+    int startAt;
+    ClientData *clientDataPtr;
 {
-    int binary = 0;
-    return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
+    FilesystemRecord *fsRecPtr, *firstFsRecPtr;
+    /* Ignore this variable */
+    (void)clientDataPtr;
+    
+    /*
+     * 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();
+
+    fsRecPtr = firstFsRecPtr;
+    while (fsRecPtr != NULL) {
+        if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
+	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
+	    if (proc != NULL) {
+		startAt = (*proc)(interp, pathPtr, startAt);
+	    }
+	    break;
+        }
+	fsRecPtr = fsRecPtr->nextPtr;
+    }
+    
+    fsRecPtr = firstFsRecPtr; 
+    while (fsRecPtr != NULL) {
+	/* 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;}
+	     * 
+	     * but there's not much benefit.
+	     */
+	}
+	fsRecPtr = fsRecPtr->nextPtr;
+    }
+
+    return startAt;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * TclGetOpenModeEx --
+ * TclGetOpenMode --
  *
+ * Description:
  *	Computes a POSIX mode mask for opening a file, from a given string,
- *	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.
+ *	and also sets a flag to indicate whether the caller should seek to
+ *	EOF after opening the file.
  *
  * Results:
  *	On success, returns mode to pass to "open". If an error occurs, the
@@ -1452,41 +1525,37 @@ TclGetOpenMode(
  *	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, 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.
+ *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller
+ *	to seek to EOF after opening the file.
  *
  * 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
-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. */
+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. */
 {
     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;
 
     /*
@@ -1494,82 +1563,66 @@ TclGetOpenModeEx(
      * routines.
      */
 
-    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_RDONLY|O_WRONLY|O_APPEND);
-		mode |= O_RDWR;
+    if (!(string[0] & 0x80)
+	    && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
+	switch (string[0]) {
+	    case 'r':
+		mode = O_RDONLY;
 		break;
-	    case 'b':
-		*binaryPtr = 1;
+	    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.
+		 */
+	        mode = O_WRONLY|O_CREAT|O_APPEND;
+                *seekFlagPtr = 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;
 	    }
-	}
-	if (modeString[i] != 0) {
+	} else if (string[1] != 0) {
 	    goto error;
 	}
-	return mode;
-
-    error:
-	*seekFlagPtr = 0;
-	*binaryPtr = 0;
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "illegal access mode \"", modeString,
-		    "\"", NULL);
-	}
-	return -1;
+        return mode;
     }
 
     /*
-     * 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, 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;
+    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;
     }
-
+    
     gotRW = 0;
     for (i = 0; i < modeArgc; i++) {
 	flag = modeArgv[i];
@@ -1585,59 +1638,55 @@ TclGetOpenModeEx(
 	    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 != NULL) {
-		Tcl_AppendResult(interp, "access mode \"", flag,
-			"\" not supported by this system", NULL);
-	    }
-	    ckfree(modeArgv);
+	    if (interp != (Tcl_Interp *) NULL) {
+                Tcl_AppendResult(interp, "access mode \"", flag,
+                        "\" not supported by this system", (char *) NULL);
+            }
+            ckfree((char *) modeArgv);
 	    return -1;
 #endif
-
 	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
-#ifdef O_NONBLOCK
+#if defined(O_NDELAY) || defined(O_NONBLOCK)
+#   ifdef O_NONBLOCK
 	    mode |= O_NONBLOCK;
+#   else
+	    mode |= O_NDELAY;
+#   endif
 #else
-	    if (interp != NULL) {
-		Tcl_AppendResult(interp, "access mode \"", flag,
-			"\" not supported by this system", NULL);
-	    }
-	    ckfree(modeArgv);
+            if (interp != (Tcl_Interp *) NULL) {
+                Tcl_AppendResult(interp, "access mode \"", flag,
+                        "\" not supported by this system", (char *) 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 != NULL) {
-		Tcl_AppendResult(interp, "invalid access mode \"", flag,
-			"\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
-			"CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", NULL);
-	    }
-	    ckfree(modeArgv);
+            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);
+            }
+	    ckfree((char *) modeArgv);
 	    return -1;
 	}
     }
-
-    ckfree(modeArgv);
-
+    ckfree((char *) modeArgv);
     if (!gotRW) {
-	if (interp != NULL) {
-	    Tcl_AppendResult(interp, "access mode must include either"
-		    " RDONLY, WRONLY, or RDWR", NULL);
-	}
+        if (interp != (Tcl_Interp *) NULL) {
+            Tcl_AppendResult(interp, "access mode must include either",
+                    " RDONLY, WRONLY, or RDWR", (char *) NULL);
+        }
 	return -1;
     }
     return mode;
@@ -1646,108 +1695,81 @@ TclGetOpenModeEx(
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FSEvalFile, Tcl_FSEvalFileEx, TclNREvalFile --
+ * Tcl_FSEvalFile --
  *
- *	Read in a file and process the entire file as one gigantic Tcl
- *	command. Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
- *	TclNREvalFile is an NRE-enabled version of Tcl_FSEvalFileEx.
+ *	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(
-    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);
-}
-
-int
-Tcl_FSEvalFileEx(
-    Tcl_Interp *interp,		/* Interpreter in which to process file. */
-    Tcl_Obj *pathPtr,		/* Path of file to process. Tilde-substitution
+Tcl_FSEvalFile(interp, pathPtr)
+    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 length, result = TCL_ERROR;
+    int result, length;
     Tcl_StatBuf statBuf;
     Tcl_Obj *oldScriptFile;
     Interp *iPtr;
-    const char *string;
+    char *string;
     Tcl_Channel chan;
     Tcl_Obj *objPtr;
 
     if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
-	return result;
+	return TCL_ERROR;
     }
 
+    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), NULL);
-	return result;
+        Tcl_SetErrno(errno);
+	Tcl_AppendResult(interp, "couldn't read file \"", 
+		Tcl_GetString(pathPtr),
+		"\": ", Tcl_PosixError(interp), (char *) NULL);
+	goto end;
     }
     chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
-    if (chan == NULL) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "couldn't read file \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
-	return result;
+    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;
     }
-
     /*
-     * 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.
+    /* 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);
-
     /*
      * If first character is not a BOM, append the remaining characters,
-     * otherwise replace them. [Bug 3466099]
+     * otherwise replace them [Bug 3466099].
      */
-
     if (Tcl_ReadChars(chan, objPtr, -1,
 	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
 	Tcl_Close(interp, chan);
@@ -1755,9 +1777,8 @@ Tcl_FSEvalFileEx(
 		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
 	goto end;
     }
-
     if (Tcl_Close(interp, chan) != TCL_OK) {
-	goto end;
+        goto end;
     }
 
     iPtr = (Interp *) interp;
@@ -1766,19 +1787,17 @@ Tcl_FSEvalFileEx(
     Tcl_IncrRefCount(iPtr->scriptFile);
     string = Tcl_GetStringFromObj(objPtr, &length);
 
-    /*
-     * TIP #280 Force the evaluator to open a frame for a sourced file.
-     */
-
+#ifdef TCL_TIP280
+    /* TIP #280 Force the evaluator to open a frame for a sourced
+     * file. */
     iPtr->evalFlags |= TCL_EVAL_FILE;
-    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
-
-    /*
+#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);
     }
@@ -1787,168 +1806,18 @@ Tcl_FSEvalFileEx(
     if (result == TCL_RETURN) {
 	result = TclUpdateReturnInfo(iPtr);
     } else if (result == TCL_ERROR) {
-	/*
-	 * Record information telling where the error occurred.
-	 */
-
-	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 ? "..." : ""), Tcl_GetErrorLine(interp)));
-    }
-
-  end:
-    Tcl_DecrRefCount(objPtr);
-    return result;
-}
-
-int
-TclNREvalFile(
-    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. */
-{
-    Tcl_StatBuf statBuf;
-    Tcl_Obj *oldScriptFile, *objPtr;
-    Interp *iPtr;
-    Tcl_Channel chan;
-    const char *string;
-
-    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
-	return TCL_ERROR;
-    }
-
-    if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
-	Tcl_SetErrno(errno);
-	Tcl_AppendResult(interp, "couldn't read file \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
-	return TCL_ERROR;
-    }
-    chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
-    if (chan == NULL) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "couldn't read file \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * 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 TCL_ERROR;
-	}
-    }
-
-    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_DecrRefCount(objPtr);
-	return TCL_ERROR;
-    }
-    string = Tcl_GetString(objPtr);
-
-    /*
-     * If first character is not a BOM, append the remaining characters,
-     * otherwise replace them. [Bug 3466099]
-     */
-
-    if (Tcl_ReadChars(chan, objPtr, -1,
-	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
-	Tcl_Close(interp, chan);
-	Tcl_AppendResult(interp, "couldn't read file \"",
-		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
-	Tcl_DecrRefCount(objPtr);
-	return TCL_ERROR;
-    }
-
-    if (Tcl_Close(interp, chan) != TCL_OK) {
-	Tcl_DecrRefCount(objPtr);
-	return TCL_ERROR;
-    }
-
-    iPtr = (Interp *) interp;
-    oldScriptFile = iPtr->scriptFile;
-    iPtr->scriptFile = pathPtr;
-    Tcl_IncrRefCount(iPtr->scriptFile);
-
-    /*
-     * TIP #280: Force the evaluator to open a frame for a sourced file.
-     */
-
-    iPtr->evalFlags |= TCL_EVAL_FILE;
-    TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
-	    NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
-}
-
-static int
-EvalFileCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *oldScriptFile = data[0];
-    Tcl_Obj *pathPtr = data[1];
-    Tcl_Obj *objPtr = data[2];
-
-    /*
-     * 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'.
-     */
-
-    if (iPtr->scriptFile != NULL) {
-	Tcl_DecrRefCount(iPtr->scriptFile);
-    }
-    iPtr->scriptFile = oldScriptFile;
+	char msg[200 + TCL_INTEGER_SPACE];
 
-    if (result == TCL_RETURN) {
-	result = TclUpdateReturnInfo(iPtr);
-    } else if (result == TCL_ERROR) {
 	/*
 	 * Record information telling where the error occurred.
 	 */
 
-	int length;
-	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
-	const int limit = 150;
-	int overflow = (length > limit);
-
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (file \"%.*s%s\" line %d)",
-		(overflow ? limit : length), pathString,
-		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+	sprintf(msg, "\n    (file \"%.150s\" line %d)", Tcl_GetString(pathPtr),
+		interp->errorLine);
+	Tcl_AddErrorInfo(interp, msg);
     }
 
+    end:
     Tcl_DecrRefCount(objPtr);
     return result;
 }
@@ -1959,27 +1828,22 @@ EvalFileCallback(
  * 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(void)
+Tcl_GetErrno()
 {
-    /*
-     * On some platforms, errno is really a thread local (implemented by the C
-     * library).
-     */
-
     return errno;
 }
 
@@ -1988,9 +1852,7 @@ Tcl_GetErrno(void)
  *
  * Tcl_SetErrno --
  *
- *	Sets the Tcl error code variable to the supplied value. On some saner
- *	platforms this is actually a thread-local (this is implemented in the
- *	C library) but this is *really* unsafe to assume!
+ *	Sets the Tcl error code variable to the supplied value.
  *
  * Results:
  *	None.
@@ -2002,14 +1864,9 @@ Tcl_GetErrno(void)
  */
 
 void
-Tcl_SetErrno(
-    int err)			/* The new value. */
+Tcl_SetErrno(err)
+    int err;			/* The new value. */
 {
-    /*
-     * On some platforms, errno is really a thread local (implemented by the C
-     * library).
-     */
-
     errno = err;
 }
 
@@ -2018,31 +1875,32 @@ Tcl_SetErrno(
  *
  * Tcl_PosixError --
  *
- *	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.
+ *	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.
  *
  * 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 errorCode field of the interp is set.
+ *	The global variable $errorCode is reset.
  *
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_PosixError(
-    Tcl_Interp *interp)		/* Interpreter whose errorCode field is to be
-				 * set. */
+CONST char *
+Tcl_PosixError(interp)
+    Tcl_Interp *interp;		/* Interpreter whose $errorCode variable
+				 * is to be changed. */
 {
-    const char *id, *msg;
+    CONST char *id, *msg;
 
     msg = Tcl_ErrnoMsg(errno);
     id = Tcl_ErrnoId();
     if (interp) {
-	Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL);
+	Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
     }
     return msg;
 }
@@ -2052,29 +1910,87 @@ Tcl_PosixError(
  *
  * Tcl_FSStat --
  *
- *	This function replaces the library version of stat and lsat.
- *
- *	The appropriate function for the filesystem to which pathPtr belongs
- *	will be called.
+ *	This procedure 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(
-    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
+Tcl_FSStat(pathPtr, buf)
+    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *buf;		/* Filled with results of stat call. */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    Tcl_Filesystem *fsPtr;
+#ifdef USE_OBSOLETE_FS_HOOKS
+    Tcl_StatBuf oldStyleStatBuffer;
+    int retVal = -1;
 
-    if (fsPtr != NULL && fsPtr->statProc != NULL) {
-	return fsPtr->statProc(pathPtr, buf);
+    /*
+     * 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;
+	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+	if (transPtr == NULL) {
+	    path = NULL;
+	} else {
+	    path = Tcl_GetString(transPtr);
+	}
+
+	statProcPtr = statProcList;
+	while ((retVal == -1) && (statProcPtr != NULL)) {
+	    retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
+	    statProcPtr = statProcPtr->nextPtr;
+	}
+	if (transPtr != NULL) {
+	    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.)
+	 */
+	buf->st_mode = oldStyleStatBuffer.st_mode;
+	buf->st_ino = oldStyleStatBuffer.st_ino;
+	buf->st_dev = oldStyleStatBuffer.st_dev;
+	buf->st_rdev = oldStyleStatBuffer.st_rdev;
+	buf->st_nlink = oldStyleStatBuffer.st_nlink;
+	buf->st_uid = oldStyleStatBuffer.st_uid;
+	buf->st_gid = oldStyleStatBuffer.st_gid;
+	buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size);
+	buf->st_atime = oldStyleStatBuffer.st_atime;
+	buf->st_mtime = oldStyleStatBuffer.st_mtime;
+	buf->st_ctime = oldStyleStatBuffer.st_ctime;
+#ifdef HAVE_ST_BLOCKS
+	buf->st_blksize = oldStyleStatBuffer.st_blksize;
+	buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
+#endif
+        return retVal;
+    }
+#endif /* USE_OBSOLETE_FS_HOOKS */
+    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSStatProc *proc = fsPtr->statProc;
+	if (proc != NULL) {
+	    return (*proc)(pathPtr, buf);
+	}
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -2085,33 +2001,36 @@ Tcl_FSStat(
  *
  * Tcl_FSLstat --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	See lstat documentation.
+ *      See lstat documentation.
  *
  * Side effects:
- *	See lstat documentation.
+ *      See lstat documentation.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSLstat(
-    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
+Tcl_FSLstat(pathPtr, buf)
+    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *buf;		/* Filled with results of stat call. */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
-	if (fsPtr->lstatProc != NULL) {
-	    return fsPtr->lstatProc(pathPtr, buf);
-	}
-	if (fsPtr->statProc != NULL) {
-	    return fsPtr->statProc(pathPtr, buf);
+	Tcl_FSLstatProc *proc = fsPtr->lstatProc;
+	if (proc != NULL) {
+	    return (*proc)(pathPtr, buf);
+	} else {
+	    Tcl_FSStatProc *sproc = fsPtr->statProc;
+	    if (sproc != NULL) {
+		return (*sproc)(pathPtr, buf);
+	    }
 	}
     }
     Tcl_SetErrno(ENOENT);
@@ -2123,28 +2042,68 @@ Tcl_FSLstat(
  *
  * Tcl_FSAccess --
  *
- *	This function replaces the library version of access. The appropriate
- *	function for the filesystem to which pathPtr belongs will be called.
+ *	This procedure 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(
-    Tcl_Obj *pathPtr,		/* Path of file to access (in current CP). */
-    int mode)			/* Permission setting. */
+Tcl_FSAccess(pathPtr, mode)
+    Tcl_Obj *pathPtr;		/* Path of file to access (in current CP). */
+    int mode;                   /* Permission setting. */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    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.
+     */
+
+    Tcl_MutexLock(&obsoleteFsHookMutex);
 
-    if (fsPtr != NULL && fsPtr->accessProc != NULL) {
-	return fsPtr->accessProc(pathPtr, mode);
+    if (accessProcList != NULL) {
+	AccessProc *accessProcPtr;
+	char *path;
+	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
+	if (transPtr == NULL) {
+	    path = NULL;
+	} else {
+	    path = Tcl_GetString(transPtr);
+	}
+
+	accessProcPtr = accessProcList;
+	while ((retVal == -1) && (accessProcPtr != NULL)) {
+	    retVal = (*accessProcPtr->proc)(path, mode);
+	    accessProcPtr = accessProcPtr->nextPtr;
+	}
+	if (transPtr != NULL) {
+	    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;
+	if (proc != NULL) {
+	    return (*proc)(pathPtr, mode);
+	}
     }
+
     Tcl_SetErrno(ENOENT);
     return -1;
 }
@@ -2154,93 +2113,111 @@ Tcl_FSAccess(
  *
  * 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(
-    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(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? */
 {
-    const Tcl_Filesystem *fsPtr;
+    Tcl_Filesystem *fsPtr;
+#ifdef USE_OBSOLETE_FS_HOOKS
     Tcl_Channel retVal = NULL;
 
     /*
-     * We need this just to ensure we return the correct error messages under
-     * some circumstances.
+     * Call each of the "Tcl_OpenFileChannel" functions in succession.
+     * A non-NULL return value indicates the particular function has
+     * succeeded.
      */
 
-    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
-	return NULL;
-    }
-
-    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) {
-	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;
-	}
-
-	/*
-	 * Do the actual open() call.
-	 */
-
-	retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode,
-		permissions);
-	if (retVal == NULL) {
-	    return NULL;
+    Tcl_MutexLock(&obsoleteFsHookMutex);
+    if (openFileChannelProcList != NULL) {
+	OpenFileChannelProc *openFileChannelProcPtr;
+	char *path;
+	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
+	
+	if (transPtr == NULL) {
+	    path = NULL;
+	} else {
+	    path = Tcl_GetString(transPtr);
 	}
 
-	/*
-	 * 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;
+	openFileChannelProcPtr = openFileChannelProcList;
+	
+	while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
+	    retVal = (*openFileChannelProcPtr->proc)(interp, path,
+						     modeString, permissions);
+	    openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
 	}
-	if (binary) {
-	    Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
+	if (transPtr != NULL) {
+	    Tcl_DecrRefCount(transPtr);
 	}
+    }
+    Tcl_MutexUnlock(&obsoleteFsHookMutex);
+    if (retVal != NULL) {
 	return retVal;
     }
-
-    /*
-     * File doesn't belong to any filesystem that can open it.
+#endif /* USE_OBSOLETE_FS_HOOKS */
+    
+    /* 
+     * We need this just to ensure we return the correct error messages
+     * under some circumstances.
      */
-
+    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == 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);
+	    if (mode == -1) {
+	        return NULL;
+	    }
+	    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;
+		    }
+		}
+	    }
+	    return retVal;
+	}
+    }
+    /* 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), NULL);
+	Tcl_AppendResult(interp, "couldn't open \"", 
+			 Tcl_GetString(pathPtr), "\": ",
+			 Tcl_PosixError(interp), (char *) NULL);
     }
     return NULL;
 }
@@ -2250,31 +2227,32 @@ Tcl_FSOpenFileChannel(
  *
  * Tcl_FSUtime --
  *
- *	This function replaces the library version of utime. The appropriate
- *	function for the filesystem to which pathPtr belongs will be called.
+ *	This procedure 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(
-    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 (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. */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
-    if (fsPtr != NULL && fsPtr->utimeProc != NULL) {
-	return fsPtr->utimeProc(pathPtr, tval);
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
+	if (proc != NULL) {
+	    return (*proc)(pathPtr, tval);
+	}
     }
-    /* TODO: set errno here? Tcl_SetErrno(ENOENT); */
     return -1;
 }
 
@@ -2283,25 +2261,25 @@ Tcl_FSUtime(
  *
  * NativeFileAttrStrings --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	An array of strings
+ *      An array of strings
  *
  * Side effects:
- *	None.
+ *      None.
  *
  *----------------------------------------------------------------------
  */
 
-static const char *const *
-NativeFileAttrStrings(
-    Tcl_Obj *pathPtr,
-    Tcl_Obj **objPtrRef)
+static CONST char**
+NativeFileAttrStrings(pathPtr, objPtrRef)
+    Tcl_Obj *pathPtr;
+    Tcl_Obj** objPtrRef;
 {
     return tclpFileAttrStrings;
 }
@@ -2311,31 +2289,34 @@ NativeFileAttrStrings(
  *
  * NativeFileAttrsGet --
  *
- *	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.
+ *	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.
  *
  * 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(
-    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(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. */
 {
-    return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef);
+    return (*tclpFileAttrProcs[index].getProc)(interp, index, 
+					       pathPtr, objPtrRef);
 }
 
 /*
@@ -2343,28 +2324,30 @@ NativeFileAttrsGet(
  *
  * NativeFileAttrsSet --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	Standard Tcl return code.
+ *      Standard Tcl return code.
  *
  * Side effects:
- *	None.
+ *      None.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-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. */
+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. */
 {
-    return tclpFileAttrProcs[index].setProc(interp, index, pathPtr, objPtr);
+    return (*tclpFileAttrProcs[index].setProc)(interp, index,
+					       pathPtr, objPtr);
 }
 
 /*
@@ -2372,34 +2355,37 @@ NativeFileAttrsSet(
  *
  * Tcl_FSFileAttrStrings --
  *
- *	This function implements part of the hookable 'file attributes'
- *	subcommand. The appropriate function for the filesystem to which
- *	pathPtr belongs will be called.
+ *	This procedure implements part of the hookable 'file
+ *	attributes' subcommand.  The appropriate function for the
+ *	filesystem to which pathPtr belongs will be called.
  *
  * Results:
- *	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.
+ *      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.
  *
  * Side effects:
- *	None.
+ *      None.
  *
  *----------------------------------------------------------------------
  */
 
-const char *const *
-Tcl_FSFileAttrStrings(
-    Tcl_Obj *pathPtr,
-    Tcl_Obj **objPtrRef)
+CONST char **
+Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
+    Tcl_Obj* pathPtr;
+    Tcl_Obj** objPtrRef;
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
-    if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) {
-	return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef);
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
+	if (proc != NULL) {
+	    return (*proc)(pathPtr, objPtrRef);
+	}
     }
     Tcl_SetErrno(ENOENT);
     return NULL;
@@ -2408,112 +2394,39 @@ Tcl_FSFileAttrStrings(
 /*
  *----------------------------------------------------------------------
  *
- * TclFSFileAttrIndex --
- *
- *	Helper function for converting an attribute name to an index into the
- *	attribute table.
- *
- * Results:
- *	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 *const *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.
+ *	This procedure 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.
+ *      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(
-    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(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. */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
-    if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) {
-	return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef);
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
+	if (proc != NULL) {
+	    return (*proc)(interp, index, pathPtr, objPtrRef);
+	}
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -2524,30 +2437,32 @@ Tcl_FSFileAttrsGet(
  *
  * Tcl_FSFileAttrsSet --
  *
- *	This function implements write access for the hookable 'file
- *	attributes' subcommand. The appropriate function for the filesystem to
- *	which pathPtr belongs will be called.
+ *	This procedure 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(
-    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(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. */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
-    if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) {
-	return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr);
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
+	if (proc != NULL) {
+	    return (*proc)(interp, index, pathPtr, objPtr);
+	}
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -2559,32 +2474,34 @@ Tcl_FSFileAttrsSet(
  * 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 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.
- *
+ *	
+ *	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.
+ *	
  *	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.
@@ -2592,230 +2509,117 @@ Tcl_FSFileAttrsSet(
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-Tcl_FSGetCwd(
-    Tcl_Interp *interp)
+Tcl_Obj*
+Tcl_FSGetCwd(interp)
+    Tcl_Interp *interp;
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    
     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.
 	 */
 
-	for (fsRecPtr = FsGetFirstFilesystem();
-		(retVal == NULL) && (fsRecPtr != NULL);
-		fsRecPtr = fsRecPtr->nextPtr) {
-	    ClientData retCd;
-	    TclFSGetCwdProc2 *proc2;
-	    if (fsRecPtr->fsPtr->getCwdProc == NULL) {
-		continue;
-	    }
-
-	    if (fsRecPtr->fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
-		retVal = fsRecPtr->fsPtr->getCwdProc(interp);
-		continue;
-	    }
-
-	    proc2 = (TclFSGetCwdProc2 *) fsRecPtr->fsPtr->getCwdProc;
-	    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,NULL);
-		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;
-		goto cdDidNotChange;
-	    } else if (interp != NULL) {
-		Tcl_AppendResult(interp,
-			"error getting working directory name: ",
-			Tcl_PosixError(interp), NULL);
+	fsRecPtr = FsGetFirstFilesystem();
+	while ((retVal == NULL) && (fsRecPtr != NULL)) {
+	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
+	    if (proc != NULL) {
+		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.
+	/* 
+	 * 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, NULL);
-
 	    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 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.
+		 * 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.
 		 */
-
-		ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);
-
-		FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
+		FsUpdateCwd(norm);
 		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.
-	 */
-
-	const Tcl_Filesystem *fsPtr =
-		Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
-	ClientData retCd = NULL;
-	Tcl_Obj *retVal, *norm;
-
-	/*
-	 * 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).
+	/* 
+	 * 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.
 	 */
-
-	if (fsPtr == NULL || fsPtr->getCwdProc == NULL) {
-	    goto cdDidNotChange;
-	}
-
-	if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
-	    retVal = fsPtr->getCwdProc(interp);
-	} else {
-	    /*
-	     * New API.
-	     */
-
-	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
-
-	    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);
-	}
-
-	/*
-	 * Check if the 'cwd' function returned an error; if so, reset the
-	 * cwd.
+	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 (retVal == NULL) {
-	    FsUpdateCwd(NULL, NULL);
-	    goto cdDidNotChange;
-	}
-
-	/*
-	 * Normalize the path.
-	 */
-
-	norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
-
-	/*
-	 * 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 */
-	    if (retCd != NULL) {
-		fsPtr->freeInternalRepProc(retCd);
-	    }
-	} else if (norm == tsdPtr->cwdPathPtr) {
-	    goto cdEqual;
-	} else {
-	    /*
-	     * 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;
-	    const 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);
+	if (fsPtr != NULL) {
+	    Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
+	    if (proc != NULL) {
+		Tcl_Obj *retVal = (*proc)(interp);
+		if (retVal != NULL) {
+		    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
+		    /* 
+		     * 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);
+		    } else {
+			FsUpdateCwd(norm);
+			Tcl_DecrRefCount(norm);
+		    }
+		    Tcl_DecrRefCount(retVal);
+		} else {
+		    /* The 'cwd' function returned an error; reset the cwd */
+		    FsUpdateCwd(NULL);
 		}
-	    } else {
-		FsUpdateCwd(norm, retCd);
-		Tcl_DecrRefCount(norm);
 	    }
 	}
-	Tcl_DecrRefCount(retVal);
     }
-
-  cdDidNotChange:
+    
     if (tsdPtr->cwdPathPtr != NULL) {
 	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
     }
-
-    return tsdPtr->cwdPathPtr;
+    
+    return tsdPtr->cwdPathPtr; 
 }
 
 /*
@@ -2824,146 +2628,131 @@ Tcl_FSGetCwd(
  * 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(
-    Tcl_Obj *pathPtr)
+Tcl_FSChdir(pathPtr)
+    Tcl_Obj *pathPtr;
 {
-    const Tcl_Filesystem *fsPtr;
+    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 retVal;
+        return -1;
     }
-
+    
     fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
     if (fsPtr != NULL) {
-	if (fsPtr->chdirProc != NULL) {
-	    /*
-	     * If this fails, an appropriate errno will have been stored using
-	     * 'Tcl_SetErrno()'.
-	     */
-
-	    retVal = fsPtr->chdirProc(pathPtr);
+	Tcl_FSChdirProc *proc = fsPtr->chdirProc;
+	if (proc != NULL) {
+	    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 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.
-		 */
-
+	    /* 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 */
 		retVal = 0;
 	    }
 	}
-    } else {
-	Tcl_SetErrno(ENOENT);
     }
 
-    /*
-     * 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 != -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.
 	 */
-
-	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.
-	     */
-
-	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-	    ClientData cd;
-	    ClientData oldcd = tsdPtr->cwdClientData;
-
-	    /*
-	     * Assumption we are using a filesystem version 2.
+	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).
 	     */
-
-	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
-
-	    cd = proc2(oldcd);
-	    if (cd != oldcd) {
-		FsUpdateCwd(normDirName, cd);
+	    Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+	    if (normDirName == NULL) {
+#ifdef WIN32
+		if (objPtr) { Tcl_DecrRefCount(objPtr); }
+#endif
+		Tcl_SetErrno(ENOENT);
+	        return -1;
 	    }
-	} else {
-	    FsUpdateCwd(normDirName, NULL);
+	    FsUpdateCwd(normDirName);
 	}
+    } else {
+	Tcl_SetErrno(ENOENT);
     }
-
-    return retVal;
+    
+#ifdef WIN32
+    if (objPtr) { Tcl_DecrRefCount(objPtr); }
+#endif
+    return (retVal);
 }
 
 /*
@@ -2971,714 +2760,397 @@ Tcl_FSChdir(
  *
  * Tcl_FSLoadFile --
  *
- *	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.
+ *	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.
  *
  * 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.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_FSLoadFile(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
+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
 				 * 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,
+    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. */
-    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)
-				/* 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. */
 {
-    const char *symbols[3];
-    void *procPtrs[2];
-    int res;
-
-    /*
-     * Initialize the arrays.
-     */
-
-    symbols[0] = sym1;
-    symbols[1] = sym2;
-    symbols[2] = NULL;
-
-    /*
-     * Perform the load.
-     */
-
-    res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
-    if (res == TCL_OK) {
-	*proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0];
-	*proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1];
-    } else {
-	*proc1Ptr = *proc2Ptr = NULL;
-    }
-
-    return res;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LoadFile --
- *
- *	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.
- *
- * 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
- *	calling TclFS_UnloadFile.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_LoadFile(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
-				 * code. */
-    const char *const symbols[],/* Names of functions to look up in the file's
-				 * symbol table. */
-    int flags,			/* Flags (unused) */
-    void *procVPtrs,		/* Where to return the addresses corresponding
-				 * to symbols[]. */
-    Tcl_LoadHandle *handlePtr)	/* Filled with token for shared library
-				 * information which can be used in
-				 * TclpFindSymbol. */
-{
-    void **procPtrs = (void **) procVPtrs;
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    const Tcl_Filesystem *copyFsPtr;
-    Tcl_FSUnloadFileProc *unloadProcPtr;
-    Tcl_Obj *copyToPtr;
-    Tcl_LoadHandle newLoadHandle = NULL;
-    Tcl_LoadHandle divertedLoadHandle = NULL;
-    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
-    FsDivertLoad *tvdlPtr;
-    int retVal;
-    int i;
-
-    if (fsPtr == NULL) {
-	Tcl_SetErrno(ENOENT);
-	return TCL_ERROR;
-    }
-
-    if (fsPtr->loadFileProc != NULL) {
-	int retVal = fsPtr->loadFileProc(interp, pathPtr, handlePtr,
-		&unloadProcPtr);
-
-	if (retVal == TCL_OK) {
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
+	if (proc != NULL) {
+	    int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
+	    if (retVal != TCL_OK) {
+		return retVal;
+	    }
 	    if (*handlePtr == NULL) {
 		return TCL_ERROR;
 	    }
-	    Tcl_ResetResult(interp);
-	    goto resolveSymbols;
-	}
-	if (Tcl_GetErrno() != EXDEV) {
+	    if (sym1 != NULL) {
+	        *proc1Ptr = TclpFindSymbol(interp, *handlePtr, sym1);
+	    }
+	    if (sym2 != NULL) {
+	        *proc2Ptr = TclpFindSymbol(interp, *handlePtr, sym2);
+	    }
 	    return retVal;
-	}
-    }
-
-    /*
-     * 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;
-    }
-
+	} 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;
+	    }
+	    
 #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:
-     */
-
-    {
-	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.
+	/* 
+	 * 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:
 	 */
-
-	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) {
-	    goto resolveSymbols;
-	}
-    }
-
-  mustCopyToTempAnyway:
-    Tcl_ResetResult(interp);
+	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);
 #endif
 
-    /*
-     * Get a temporary filename to use, first to copy the file into, and then
-     * to load.
-     */
-
-    copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);
-    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;
-    }
-
-#ifndef __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:
-     */
-
-    {
-	int index;
-	Tcl_Obj *perm;
-
-	TclNewLiteralStringObj(perm, "0700");
-	Tcl_IncrRefCount(perm);
-	if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
-	    Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
-	}
-	Tcl_DecrRefCount(perm);
-    }
+	    /* 
+	     * 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;
+
+#if !defined(__WIN32__) && !defined(MAC_TCL)
+		/* 
+		 * 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));
 
-    /*
-     * 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_LoadFile(interp, copyToPtr, symbols, 0, procPtrs,
-	    &newLoadHandle);
-    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;
-	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 = 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;
-
-    divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_));
-    divertedLoadHandle->clientData = tvdlPtr;
-    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
-    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
-    *handlePtr = divertedLoadHandle;
-
-    Tcl_ResetResult(interp);
-    return retVal;
-
-  resolveSymbols:
-    /* 
-     * At this point, *handlePtr is already set up to the handle for the
-     * loaded library. We now try to resolve the symbols.
-     */
-
-    if (symbols != NULL) {
-	for (i=0 ; symbols[i] != NULL; i++) {
-	    procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]);
-	    if (procPtrs[i] == NULL) {
 		/* 
-		 * At least one symbol in the list was not found.  Unload the
-		 * file, and report the problem back to the caller.
-		 * (Tcl_FindSymbol should already have left an appropriate
-		 * error message.)
+		 * 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);
+		}
 
-		(*handlePtr)->unloadFileProcPtr(*handlePtr);
-		*handlePtr = NULL;
+		copyToPtr = NULL;
+		(*handlePtr) = (Tcl_LoadHandle) tvdlPtr;
+		(*unloadProcPtr) = &FSUnloadTempFile;
+		return retVal;
+	    } else {
+		/* Cross-platform copy failed */
+		Tcl_FSDeleteFile(copyToPtr);
+		Tcl_DecrRefCount(copyToPtr);
 		return TCL_ERROR;
 	    }
 	}
     }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DivertFindSymbol --
- *	
- *	Find a symbol in a shared library loaded by copy-from-VFS.
- *
- *----------------------------------------------------------------------
- */
-
-static void *
-DivertFindSymbol(
-    Tcl_Interp *interp, 	/* Tcl interpreter */
-    Tcl_LoadHandle loadHandle,	/* Handle to the diverted module */
-    const char *symbol)		/* Symbol to resolve */
-{
-    FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData;
-    Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle;
-
-    return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * DivertUnloadFile --
- *
- *	Unloads a file that has been loaded by copying from VFS to the native
- *	filesystem.
- *
- * Parameters:
- *	loadHandle -- Handle of the file to unload
- *
- *----------------------------------------------------------------------
- */
-
-static void
-DivertUnloadFile(
-    Tcl_LoadHandle loadHandle)
-{
-    FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData;
-    Tcl_LoadHandle originalHandle;
-
-    /*
-     * This test should never trigger, since we give the client data in the
-     * function above.
-     */
-
-    if (tvdlPtr == NULL) {
-	return;
-    }
-    originalHandle = tvdlPtr->loadHandle;
-
-    /*
-     * 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.
-     */
-
-    originalHandle->unloadFileProcPtr(originalHandle);
-
-    /*
-     * What filesystem contains the temp copy of the library?
-     */
-
-    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.
-	 */
-
-	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.
-	 */
-
-	if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
-		!= 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.
-	     */
-	}
-
-	/*
-	 * 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);
-    }
-
-    ckfree(tvdlPtr);
-    ckfree(loadHandle);
+    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.
+/* 
+ * This function used to be in the platform specific directories, but it
+ * has now been made to work cross-platform
  */
-
 int
-TclpLoadFile(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
+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, const char *sym2,
-				/* Names of two functions to look up in the
-				 * file's symbol table. */
-    Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
+    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
+    ClientData *clientDataPtr;	/* 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_LoadHandle handle = NULL;
     int res;
-
+    
     res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
-
+    
     if (res != TCL_OK) {
-	return res;
+        return res;
     }
 
     if (handle == NULL) {
 	return TCL_ERROR;
     }
-
-    *clientDataPtr = handle;
-
-    *proc1Ptr = (Tcl_PackageInitProc*) Tcl_FindSymbol(interp, handle, sym1);
-    *proc2Ptr = (Tcl_PackageInitProc*) Tcl_FindSymbol(interp, handle, sym2);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FindSymbol --
- *
- *	Find a symbol in a loaded library
- *
- * Results:
- *	Returns a pointer to the symbol if found. If not found, returns NULL
- *	and leaves an error message in the interpreter result.
- *
- * This function was once filesystem-specific, but has been made portable by
- * having TclpDlopen return a structure that includes procedure pointers.
- *
- *----------------------------------------------------------------------
- */
-
-void *
-Tcl_FindSymbol(
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    Tcl_LoadHandle loadHandle,	/* Handle to the loaded library */
-    const char *symbol)		/* Name of the symbol to resolve */
-{
-    return loadHandle->findSymbolProcPtr(interp, loadHandle, symbol);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FSUnloadFile --
- *
- *	Unloads a library given its handle. Checks first that the library
- *	supports unloading.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_FSUnloadFile(
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    Tcl_LoadHandle handle)	/* Handle of the file to unload */
-{
-    if (handle->unloadFileProcPtr == NULL) {
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "cannot unload: filesystem does not support unloading",
-		    -1));
-	}
-	return TCL_ERROR;
-    }
-    TclpUnloadFile(handle);
+    
+    *clientDataPtr = (ClientData)handle;
+    
+    *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
+    *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
     return TCL_OK;
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * TclpUnloadFile --
- *
- *	Unloads a library given its handle
- *
- * This function was once filesystem-specific, but has been made portable by
- * having TclpDlopen return a structure that includes procedure pointers.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpUnloadFile(
-    Tcl_LoadHandle handle)
-{
-    if (handle->unloadFileProcPtr != NULL) {
-	handle->unloadFileProcPtr(handle);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  *
- * TclFSUnloadTempFile --
+ * FSUnloadTempFile --
  *
- *	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.
  *
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
  */
-
-void
-TclFSUnloadTempFile(
-    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
-				 * Tcl_FSLoadFile(). The loadHandle is a token
-				 * that represents the loaded file. */
+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. */
 {
-    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);
+	(*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);
     }
 
-    ckfree(tvdlPtr);
+    ckfree((char*)tvdlPtr);
 }
 
 /*
@@ -3686,56 +3158,59 @@ TclFSUnloadTempFile(
  *
  * 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(
-    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(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 */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
-    if (fsPtr != NULL && fsPtr->linkProc != NULL) {
-	return fsPtr->linkProc(pathPtr, toPtr, linkAction);
+    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; /* TODO: Change to Tcl_SetErrno()? */
+    errno = EINVAL;
 #else
     Tcl_SetErrno(ENOENT);
 #endif /* S_IFLNK */
@@ -3747,16 +3222,17 @@ Tcl_FSLink(
  *
  * 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.
@@ -3767,24 +3243,24 @@ Tcl_FSLink(
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj *
+Tcl_Obj*
 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();
     while (fsRecPtr != NULL) {
-	if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
-	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
-
+	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
+	if (proc != NULL) {
+	    Tcl_Obj *thisFsVolumes = (*proc)();
 	    if (thisFsVolumes != NULL) {
 		Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
 		Tcl_DecrRefCount(thisFsVolumes);
@@ -3792,7 +3268,7 @@ Tcl_FSListVolumes(void)
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-
+    
     return resultPtr;
 }
 
@@ -3801,12 +3277,13 @@ 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
@@ -3814,35 +3291,37 @@ Tcl_FSListVolumes(void)
  *---------------------------------------------------------------------------
  */
 
-static Tcl_Obj *
-FsListMounts(
-    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
-    const char *pattern)	/* Pattern to match against. */
+static Tcl_Obj*
+FsListMounts(pathPtr, pattern)
+    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 "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.
+     * 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.
      */
 
     fsRecPtr = FsGetFirstFilesystem();
     while (fsRecPtr != NULL) {
-	if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
-		fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
-	    if (resultPtr == NULL) {
-		resultPtr = Tcl_NewObj();
+	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
+	    Tcl_FSMatchInDirectoryProc *proc = 
+				  fsRecPtr->fsPtr->matchInDirectoryProc;
+	    if (proc != NULL) {
+		if (resultPtr == NULL) {
+		    resultPtr = Tcl_NewObj();
+		}
+		(*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
 	    }
-	    fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr,
-		    pattern, &mountsOnly);
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-
+    
     return resultPtr;
 }
 
@@ -3851,14 +3330,14 @@ FsListMounts(
  *
  * 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.
@@ -3866,23 +3345,23 @@ FsListMounts(
  *---------------------------------------------------------------------------
  */
 
-Tcl_Obj *
-Tcl_FSSplitPath(
-    Tcl_Obj *pathPtr,		/* Path to split. */
-    int *lenPtr)		/* int to store number of path elements. */
+Tcl_Obj* 
+Tcl_FSSplitPath(pathPtr, lenPtr)
+    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. */
-    const Tcl_Filesystem *fsPtr;
+    Tcl_Obj *result = NULL;  /* Needed only to prevent gcc warnings. */
+    Tcl_Filesystem *fsPtr;
     char separator = '/';
     int driveNameLength;
-    const char *p;
-
+    char *p;
+    
     /*
-     * Perform platform specific splitting.
+     * Perform platform specific splitting. 
      */
 
-    if (TclFSGetPathType(pathPtr, &fsPtr,
-	    &driveNameLength) == TCL_PATH_ABSOLUTE) {
+    if (FSGetPathType(pathPtr, &fsPtr, &driveNameLength) 
+	== TCL_PATH_ABSOLUTE) {
 	if (fsPtr == &tclNativeFilesystem) {
 	    return TclpNativeSplitPath(pathPtr, lenPtr);
 	}
@@ -3890,49 +3369,38 @@ Tcl_FSSplitPath(
 	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);
-
+	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 (;;) {
-	const char *elementStart = p;
+	char *elementStart = p;
 	int length;
-
 	while ((*p != '\0') && (*p != separator)) {
 	    p++;
 	}
 	length = p - elementStart;
 	if (length > 0) {
 	    Tcl_Obj *nextElt;
-
 	    if (elementStart[0] == '~') {
-		TclNewLiteralStringObj(nextElt, "./");
+		nextElt = Tcl_NewStringObj("./",2);
 		Tcl_AppendToObj(nextElt, elementStart, length);
 	    } else {
 		nextElt = Tcl_NewStringObj(elementStart, length);
@@ -3943,23 +3411,23 @@ Tcl_FSSplitPath(
 	    break;
 	}
     }
-
+			     
     /*
      * Compute the number of elements in the result.
      */
 
     if (lenPtr != NULL) {
-	TclListObjLength(NULL, result, lenPtr);
+	Tcl_ListObjLength(NULL, result, lenPtr);
     }
     return result;
 }
-
-/* Simple helper function. */
-Tcl_Obj *
-TclFSInternalToNormalized(
-    const Tcl_Filesystem *fromFilesystem,
-    ClientData clientData,
-    FilesystemRecord **fsRecPtrPtr)
+
+/* Simple helper function */
+Tcl_Obj* 
+TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
+    Tcl_Filesystem *fromFilesystem;
+    ClientData clientData;
+    FilesystemRecord **fsRecPtrPtr;
 {
     FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
 
@@ -3970,80 +3438,26 @@ TclFSInternalToNormalized(
 	}
 	fsRecPtr = fsRecPtr->nextPtr;
     }
-
-    if ((fsRecPtr == NULL)
-	    || (fromFilesystem->internalToNormalizedProc == NULL)) {
+    
+    if ((fsRecPtr != NULL) 
+      && (fromFilesystem->internalToNormalizedProc != NULL)) {
+	return (*fromFilesystem->internalToNormalizedProc)(clientData);
+    } else {
 	return NULL;
     }
-    return fromFilesystem->internalToNormalizedProc(clientData);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclGetPathType --
+ * GetPathType --
  *
  *	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. */
-    const 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. */
-{
-    int pathLen;
-    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
-    Tcl_PathType type;
-
-    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;
-	}
-    }
-    return type;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFSNonnativePathType --
- *
- *	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 or TCL_PATH_RELATIVE. The filesystem
- *	reference will be set if and only if it is non-NULL and the function's
+ *	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:
@@ -4052,76 +3466,70 @@ TclGetPathType(
  *----------------------------------------------------------------------
  */
 
-Tcl_PathType
-TclFSNonnativePathType(
-    const char *path,		/* Path to determine type for. */
-    int pathLen,		/* Length of the path. */
-    const 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. */
+static Tcl_PathType
+GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
+    Tcl_Obj *pathObjPtr;
+    Tcl_Filesystem **filesystemPtrPtr;
+    int *driveNameLengthPtr;
+    Tcl_Obj **driveNameRef;
 {
     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();
     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 win, unix) but the list of volumes we get by calling
-	 * fsRecPtr->fsPtr->listVolumesProc 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 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.
 	 */
-
-	if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
-		&& (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
+	if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
 	    int numVolumes;
-	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
-
+	    Tcl_Obj *thisFsVolumes = (*proc)();
 	    if (thisFsVolumes != NULL) {
-		if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
-			!= TCL_OK) {
-		    /*
-		     * This is VERY bad; the listVolumesProc 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).
+		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).
 		     */
-
 		    numVolumes = -1;
 		}
 		while (numVolumes > 0) {
 		    Tcl_Obj *vol;
 		    int len;
-		    const char *strVol;
+		    char *strVol;
 
 		    numVolumes--;
 		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
@@ -4146,16 +3554,21 @@ TclFSNonnativePathType(
 		}
 		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;
+	}
+    }
     return type;
 }
 
@@ -4164,12 +3577,12 @@ TclFSNonnativePathType(
  *
  * 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.
@@ -4178,21 +3591,22 @@ TclFSNonnativePathType(
  */
 
 int
-Tcl_FSRenameFile(
-    Tcl_Obj *srcPathPtr,	/* Pathname of file or dir to be renamed
+Tcl_FSRenameFile(srcPathPtr, destPathPtr)
+    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;
-    const Tcl_Filesystem *fsPtr, *fsPtr2;
-
+    Tcl_Filesystem *fsPtr, *fsPtr2;
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
-    if ((fsPtr == fsPtr2) && (fsPtr != NULL)
-	    && (fsPtr->renameFileProc != NULL)) {
-	retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr);
+    if (fsPtr == fsPtr2 && fsPtr != NULL) {
+	Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
+	if (proc != NULL) {
+	    retVal =  (*proc)(srcPathPtr, destPathPtr);
+	}
     }
     if (retVal == -1) {
 	Tcl_SetErrno(EXDEV);
@@ -4205,16 +3619,16 @@ Tcl_FSRenameFile(
  *
  * 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.
@@ -4222,19 +3636,21 @@ Tcl_FSRenameFile(
  *---------------------------------------------------------------------------
  */
 
-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 
+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 retVal = -1;
-    const Tcl_Filesystem *fsPtr, *fsPtr2;
-
+    Tcl_Filesystem *fsPtr, *fsPtr2;
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
-    if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyFileProc != NULL) {
-	retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr);
+    if (fsPtr == fsPtr2 && fsPtr != NULL) {
+	Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
+	if (proc != NULL) {
+	    retVal = (*proc)(srcPathPtr, destPathPtr);
+	}
     }
     if (retVal == -1) {
 	Tcl_SetErrno(EXDEV);
@@ -4247,76 +3663,64 @@ Tcl_FSCopyFile(
  *
  * 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(
-    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(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 result = TCL_ERROR;
     int prot = 0666;
-    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);
+    
+    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);
+	    }
+	}
     }
-
-  done:
     return result;
 }
 
@@ -4325,11 +3729,11 @@ TclCrossFilesystemCopy(
  *
  * 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.
@@ -4338,13 +3742,15 @@ TclCrossFilesystemCopy(
  */
 
 int
-Tcl_FSDeleteFile(
-    Tcl_Obj *pathPtr)		/* Pathname of file to be removed (UTF-8). */
+Tcl_FSDeleteFile(pathPtr)
+    Tcl_Obj *pathPtr;		/* Pathname of file to be removed (UTF-8). */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
-    if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) {
-	return fsPtr->deleteFileProc(pathPtr);
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
+	if (proc != NULL) {
+	    return (*proc)(pathPtr);
+	}
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -4355,11 +3761,11 @@ Tcl_FSDeleteFile(
  *
  * 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.
@@ -4368,13 +3774,15 @@ Tcl_FSDeleteFile(
  */
 
 int
-Tcl_FSCreateDirectory(
-    Tcl_Obj *pathPtr)		/* Pathname of directory to create (UTF-8). */
+Tcl_FSCreateDirectory(pathPtr)
+    Tcl_Obj *pathPtr;		/* Pathname of directory to create (UTF-8). */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-
-    if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) {
-	return fsPtr->createDirectoryProc(pathPtr);
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != NULL) {
+	Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
+	if (proc != NULL) {
+	    return (*proc)(pathPtr);
+	}
     }
     Tcl_SetErrno(ENOENT);
     return -1;
@@ -4385,12 +3793,12 @@ Tcl_FSCreateDirectory(
  *
  * 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.
@@ -4399,22 +3807,24 @@ Tcl_FSCreateDirectory(
  */
 
 int
-Tcl_FSCopyDirectory(
-    Tcl_Obj *srcPathPtr,	/* Pathname of directory to be copied
+Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
+    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;
-    const Tcl_Filesystem *fsPtr, *fsPtr2;
-
+    Tcl_Filesystem *fsPtr, *fsPtr2;
     fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
     fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
 
-    if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyDirectoryProc != NULL){
-	retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr);
+    if (fsPtr == fsPtr2 && fsPtr != NULL) {
+	Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
+	if (proc != NULL) {
+	    retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
+	}
     }
     if (retVal == -1) {
 	Tcl_SetErrno(EXDEV);
@@ -4427,11 +3837,11 @@ Tcl_FSCopyDirectory(
  *
  * 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.
@@ -4440,298 +3850,2257 @@ Tcl_FSCopyDirectory(
  */
 
 int
-Tcl_FSRemoveDirectory(
-    Tcl_Obj *pathPtr,		/* Pathname of directory to be removed
+Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
+    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. */
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    if (fsPtr != 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);
+			}
+		    }
+		    Tcl_DecrRefCount(cwdPtr);
+		}
+	    }
+	    return (*proc)(pathPtr, recursive, errorPtr);
+	}
+    }
+    Tcl_SetErrno(ENOENT);
+    return -1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+.*      NULL or a filesystem which will accept this path.
+ *
+ * Side effects:
+ *	The object may be converted to a path type.
+ *
+ *---------------------------------------------------------------------------
+ */
 
-    if (fsPtr == NULL || fsPtr->removeDirectoryProc == NULL) {
-	Tcl_SetErrno(ENOENT);
-	return -1;
+Tcl_Filesystem*
+Tcl_FSGetFileSystemForPath(pathObjPtr)
+    Tcl_Obj* pathObjPtr;
+{
+    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 (pathObjPtr->refCount == 0) {
+	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.
+     */
+
+    fsRecPtr = FsGetFirstFilesystem();
+
+    if (TclFSEnsureEpochOk(pathObjPtr, &retVal) != TCL_OK) {
+	return NULL;
     }
 
     /*
-     * When working recursively, we check whether the cwd lies inside this
-     * directory and move it if it does.
+     * Call each of the "pathInFilesystem" functions in succession.  A
+     * non-return value of -1 indicates the particular function has
+     * succeeded.
      */
 
-    if (recursive) {
-	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
-
-	if (cwdPtr != NULL) {
-	    const 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]'.
-		     */
+    while ((retVal == NULL) && (fsRecPtr != NULL)) {
+	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.
+		 */
+		TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData);
+		retVal = fsRecPtr->fsPtr;
+	    }
+	}
+	fsRecPtr = fsRecPtr->nextPtr;
+    }
 
-		    Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
-			    TCL_PATH_DIRNAME);
+    return retVal;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *      NULL or a valid native path.
+ *
+ * Side effects:
+ *	See Tcl_FSGetInternalRep.
+ *
+ *---------------------------------------------------------------------------
+ */
 
-		    Tcl_FSChdir(dirPtr);
-		    Tcl_DecrRefCount(dirPtr);
-		}
-	    }
-	    Tcl_DecrRefCount(cwdPtr);
+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;
 	}
     }
-    return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
+#endif
+
+    objPtr = Tcl_NewStringObj(copy,len);
+    Tcl_DStringFree(&ds);
+    
+    return objPtr;
 }
+
 
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_FSGetFileSystemForPath --
+ * TclNativeDupInternalRep --
  *
- *	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.
+ *      Duplicate the native representation.
  *
  * Results:
- *	NULL or a filesystem which will accept this path.
+ *      The copied native representation, or NULL if it is not possible
+ *      to copy the representation.
  *
  * Side effects:
- *	The object may be converted to a path type.
+ *	None.
  *
  *---------------------------------------------------------------------------
  */
+ClientData 
+TclNativeDupInternalRep(clientData)
+    ClientData clientData;
+{
+    ClientData copy;
+    size_t len;
+
+    if (clientData == NULL) {
+	return NULL;
+    }
 
-const Tcl_Filesystem *
-Tcl_FSGetFileSystemForPath(
-    Tcl_Obj *pathPtr)
+#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;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NativeFreeInternalRep --
+ *
+ *      Free a native internal representation, which will be non-NULL.
+ *
+ * Results:
+ *      None.
+ *
+ * Side effects:
+ *	Memory is released.
+ *
+ *---------------------------------------------------------------------------
+ */
+static void 
+NativeFreeInternalRep(clientData)
+    ClientData clientData;
 {
-    FilesystemRecord *fsRecPtr;
-    const Tcl_Filesystem *retVal = NULL;
+    ckfree((char*)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.
+ *
+ * Results:
+ *      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 *resPtr;
+    Tcl_FSFilesystemPathTypeProc *proc;
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
+    
+    if (fsPtr == NULL) {
+	return NULL;
+    }
+    
+    resPtr = Tcl_NewListObj(0,NULL);
+    
+    Tcl_ListObjAppendElement(NULL, resPtr, 
+			     Tcl_NewStringObj(fsPtr->typeName,-1));
 
-    if (pathPtr == NULL) {
-	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
+    proc = fsPtr->filesystemPathTypeProc;
+    if (proc != NULL) {
+	Tcl_Obj *typePtr = (*proc)(pathObjPtr);
+	if (typePtr != NULL) {
+	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
+	}
+    }
+    
+    return resPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_FSPathSeparator --
+ *
+ *      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.
+ *
+ * Side effects:
+ *	The path object may be converted to a path type.
+ *
+ *---------------------------------------------------------------------------
+ */
+Tcl_Obj*
+Tcl_FSPathSeparator(pathObjPtr)
+    Tcl_Obj* pathObjPtr;
+{
+    Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
+    
+    if (fsPtr == NULL) {
 	return NULL;
     }
+    if (fsPtr->filesystemSeparatorProc != NULL) {
+	return (*fsPtr->filesystemSeparatorProc)(pathObjPtr);
+    }
+    
+    return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NativeFilesystemSeparator --
+ *
+ *      This function is part of the native filesystem support, and
+ *      returns the separator for the given path.
+ *
+ * Results:
+ *      String object containing the separator character.
+ *
+ * Side effects:
+ *	None.
+ *
+ *---------------------------------------------------------------------------
+ */
+static Tcl_Obj*
+NativeFilesystemSeparator(pathObjPtr)
+    Tcl_Obj* pathObjPtr;
+{
+    char *separator = NULL; /* lint */
+    switch (tclPlatform) {
+	case TCL_PLATFORM_UNIX:
+	    separator = "/";
+	    break;
+	case TCL_PLATFORM_WINDOWS:
+	    separator = "\\";
+	    break;
+	case TCL_PLATFORM_MAC:
+	    separator = ":";
+	    break;
+    }
+    return Tcl_NewStringObj(separator,1);
+}
+
+/* Everything from here on is contained in this obsolete ifdef */
+#ifdef USE_OBSOLETE_FS_HOOKS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *      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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStatInsertProc (proc)
+    TclStatProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	StatProc *newStatProcPtr;
+
+	newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));
+
+	if (newStatProcPtr != NULL) {
+	    newStatProcPtr->proc = proc;
+	    Tcl_MutexLock(&obsoleteFsHookMutex);
+	    newStatProcPtr->nextPtr = statProcList;
+	    statProcList = newStatProcPtr;
+	    Tcl_MutexUnlock(&obsoleteFsHookMutex);
 
+	    retVal = TCL_OK;
+	}
+    }
+
+    return retVal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclStatDeleteProc --
+ *
+ *	Removed the passed function pointer from the list of 'TclStat'
+ *	functions.  Ensures that the built-in stat function is not
+ *	removvable.
+ *
+ * Results:
+ *      TCL_OK if the procedure pointer was successfully removed,
+ *	TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *      Memory is deallocated and the respective list updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclStatDeleteProc (proc)
+    TclStatProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    StatProc *tmpStatProcPtr;
+    StatProc *prevStatProcPtr = NULL;
+
+    Tcl_MutexLock(&obsoleteFsHookMutex);
+    tmpStatProcPtr = statProcList;
     /*
-     * 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).
+     * 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.
      */
 
-    if (pathPtr->refCount == 0) {
-	Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
-	return NULL;
+    while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
+	if (tmpStatProcPtr->proc == proc) {
+	    if (prevStatProcPtr == NULL) {
+		statProcList = tmpStatProcPtr->nextPtr;
+	    } else {
+		prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
+	    }
+
+	    ckfree((char *)tmpStatProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevStatProcPtr = tmpStatProcPtr;
+	    tmpStatProcPtr = tmpStatProcPtr->nextPtr;
+	}
     }
 
+    Tcl_MutexUnlock(&obsoleteFsHookMutex);
+
+    return retVal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *      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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccessInsertProc(proc)
+    TclAccessProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	AccessProc *newAccessProcPtr;
+
+	newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));
+
+	if (newAccessProcPtr != NULL) {
+	    newAccessProcPtr->proc = proc;
+	    Tcl_MutexLock(&obsoleteFsHookMutex);
+	    newAccessProcPtr->nextPtr = accessProcList;
+	    accessProcList = newAccessProcPtr;
+	    Tcl_MutexUnlock(&obsoleteFsHookMutex);
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return retVal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclAccessDeleteProc --
+ *
+ *	Removed the passed function pointer from the list of 'TclAccess'
+ *	functions.  Ensures that the built-in access function is not
+ *	removvable.
+ *
+ * Results:
+ *      TCL_OK if the procedure pointer was successfully removed,
+ *	TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *      Memory is deallocated and the respective list updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclAccessDeleteProc(proc)
+    TclAccessProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    AccessProc *tmpAccessProcPtr;
+    AccessProc *prevAccessProcPtr = 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.
+     * 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.
      */
 
-    fsRecPtr = FsGetFirstFilesystem();
-    if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
-	return NULL;
-    } else if (retVal != NULL) {
-	/* TODO: Can this happen? */
-	return retVal;
+    Tcl_MutexLock(&obsoleteFsHookMutex);
+    tmpAccessProcPtr = accessProcList;
+    while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) {
+	if (tmpAccessProcPtr->proc == proc) {
+	    if (prevAccessProcPtr == NULL) {
+		accessProcList = tmpAccessProcPtr->nextPtr;
+	    } else {
+		prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
+	    }
+
+	    ckfree((char *)tmpAccessProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevAccessProcPtr = tmpAccessProcPtr;
+	    tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
+	}
     }
+    Tcl_MutexUnlock(&obsoleteFsHookMutex);
+
+    return retVal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *      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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclOpenFileChannelInsertProc(proc)
+    TclOpenFileChannelProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+
+    if (proc != NULL) {
+	OpenFileChannelProc *newOpenFileChannelProcPtr;
+
+	newOpenFileChannelProcPtr =
+		(OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));
+
+	if (newOpenFileChannelProcPtr != NULL) {
+	    newOpenFileChannelProcPtr->proc = proc;
+	    Tcl_MutexLock(&obsoleteFsHookMutex);
+	    newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
+	    openFileChannelProcList = newOpenFileChannelProcPtr;
+	    Tcl_MutexUnlock(&obsoleteFsHookMutex);
+
+	    retVal = TCL_OK;
+	}
+    }
+
+    return retVal;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ * Results:
+ *      TCL_OK if the procedure pointer was successfully removed,
+ *	TCL_ERROR otherwise.
+ *
+ * Side effects:
+ *      Memory is deallocated and the respective list updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclOpenFileChannelDeleteProc(proc)
+    TclOpenFileChannelProc_ *proc;
+{
+    int retVal = TCL_ERROR;
+    OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
+    OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
 
     /*
-     * Call each of the "pathInFilesystem" functions in succession. A
-     * non-return value of -1 indicates the particular function has succeeded.
+     * Traverse the 'openFileChannelProcList' looking for the particular
+     * node whose 'proc' member matches 'proc' and remove that one from
+     * the list.  
      */
 
-    for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) {
-	ClientData clientData = NULL;
+    Tcl_MutexLock(&obsoleteFsHookMutex);
+    tmpOpenFileChannelProcPtr = openFileChannelProcList;
+    while ((retVal == TCL_ERROR) &&
+	    (tmpOpenFileChannelProcPtr != NULL)) {
+	if (tmpOpenFileChannelProcPtr->proc == proc) {
+	    if (prevOpenFileChannelProcPtr == NULL) {
+		openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
+	    } else {
+		prevOpenFileChannelProcPtr->nextPtr =
+			tmpOpenFileChannelProcPtr->nextPtr;
+	    }
 
-	if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) {
-	    continue;
+	    ckfree((char *)tmpOpenFileChannelProcPtr);
+
+	    retVal = TCL_OK;
+	} else {
+	    prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
+	    tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
 	}
+    }
+    Tcl_MutexUnlock(&obsoleteFsHookMutex);
+
+    return retVal;
+}
+#endif /* USE_OBSOLETE_FS_HOOKS */
 
-	if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, &clientData)!=-1) {
-	    /*
-	     * We assume the type of pathPtr hasn't been changed by the above
-	     * call to the pathInFilesystemProc.
-	     */
 
-	    TclFSSetPathDetails(pathPtr, fsRecPtr, clientData);
-	    return fsRecPtr->fsPtr;
+/*
+ * 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;
+			}
+		    } else if (tclPlatform == TCL_PLATFORM_MAC) {
+			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;
+	    }
+	}
 
-    return NULL;
+	/* 
+	 * 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);
+		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_FSGetNativePath --
+ * Tcl_FSConvertToPathType --
  *
- *	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 desirable 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.
+ *      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:
- *	NULL or a valid native path.
+ *      Standard Tcl error code.
  *
  * Side effects:
- *	See Tcl_FSGetInternalRep.
+ *	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);
 
-const void *
-Tcl_FSGetNativePath(
-    Tcl_Obj *pathPtr)
+    /* 
+     * 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;
 {
-    return Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
+    int count = 0;
+    switch (tclPlatform) {
+	case TCL_PLATFORM_UNIX:
+	case TCL_PLATFORM_MAC:
+	    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;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * NativeFreeInternalRep --
+ * TclNewFSPathObj --
  *
- *	Free a native internal representation, which will be non-NULL.
+ *      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));
+    
+    if (tclPlatform == TCL_PLATFORM_MAC) { 
+	/* 
+	 * Mac relative paths may begin with a directory separator ':'. 
+	 * If present, we need to skip this ':' because we assume that 
+	 * we can join dirPtr and addStrRep by concatenating them as 
+	 * strings (and we ensure that dirPtr is terminated by a ':'). 
+	 */ 
+	if (addStrRep[0] == ':') { 
+	    addStrRep++; 
+	    len--; 
+	} 
+    } 
+    /* 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:
- *	None.
+ *      NULL on error, otherwise a valid object, typically with
+ *      refCount of zero, which it is assumed the caller will
+ *      increment.
  *
  * Side effects:
- *	Memory is released.
+ *	The old representation may be freed, and new memory allocated.
  *
  *---------------------------------------------------------------------------
  */
 
-static void
-NativeFreeInternalRep(
-    ClientData clientData)
+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. */
 {
-    ckfree(clientData);
+    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;
+	case TCL_PLATFORM_MAC:
+	    if (tempStr[cwdLen-1] != ':') {
+		cwdLen++;
+	    }
+	    break;
+    }
+    tempStr = Tcl_GetStringFromObj(objPtr, &len);
+
+    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_FSFileSystemInfo --
+ * 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, nativeRep)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr;		/* The object to convert. */
+    ClientData nativeRep;	/* The native rep for the object, if known
+				 * else NULL. */
+{
+    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 = nativeRep;
+    fsPathPtr->fsRecPtr = NULL;
+    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
+
+    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
+    PATHFLAGS(objPtr) = 0;
+    objPtr->typePtr = &tclFsPathType;
+
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
  *
- *	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.
+ * 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:
- *	A list of two elements.
+ *      NULL or a valid path object pointer, with refCount zero.
  *
  * Side effects:
- *	The object may be converted to a path type.
+ *	New memory may be allocated.
  *
  *---------------------------------------------------------------------------
  */
 
 Tcl_Obj *
-Tcl_FSFileSystemInfo(
-    Tcl_Obj *pathPtr)
+Tcl_FSNewNativePath(fromFilesystem, clientData)
+    Tcl_Filesystem* fromFilesystem;
+    ClientData clientData;
 {
-    Tcl_Obj *resPtr;
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+    Tcl_Obj *objPtr;
+    FsPath *fsPathPtr;
 
-    if (fsPtr == NULL) {
+    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));
 
-    resPtr = Tcl_NewListObj(0, NULL);
-    Tcl_ListObjAppendElement(NULL, resPtr,
-	    Tcl_NewStringObj(fsPtr->typeName, -1));
+    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;
 
-    if (fsPtr->filesystemPathTypeProc != NULL) {
-	Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr);
+    PATHOBJ(objPtr) = (VOID *) fsPathPtr;
+    PATHFLAGS(objPtr) = 0;
+    objPtr->typePtr = &tclFsPathType;
 
-	if (typePtr != NULL) {
-	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
+    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;
     }
 
-    return resPtr;
+    if (retObj) {
+	Tcl_IncrRefCount(retObj);
+    }
+    return retObj;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_FSPathSeparator --
+ * Tcl_FSGetTranslatedStringPath --
  *
- *	This function returns the separator to be used for a given path. The
- *	object returned should have a refCount of zero
+ *      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:
- *	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.
+ *      NULL or a valid string.
  *
  * Side effects:
- *	The path object may be converted to a path type.
+ *	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;
+    }
 
-Tcl_Obj *
-Tcl_FSPathSeparator(
-    Tcl_Obj *pathPtr)
+    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;
 {
-    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
-    Tcl_Obj *resultObj;
+    FsPath *fsPathPtr;
 
-    if (fsPtr == NULL) {
+    if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
 	return NULL;
     }
+    fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
 
-    if (fsPtr->filesystemSeparatorProc != NULL) {
-	return fsPtr->filesystemSeparatorProc(pathPtr);
+    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;
+	ClientData clientData = NULL;
+	
+	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;
+	    case TCL_PLATFORM_MAC:
+		if (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, NULL);
+	    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,
+		    (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
+	}
+
+	/* 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);
+	}
+	if (clientData != NULL) {
+	    /*
+	     * This may be unnecessary. It appears that the
+	     * TclFSNormalizeToUniquePath call above should have already
+	     * set this up.  Not changing out of fear of the unknown.
+	     */
+	    fsPathPtr->nativePathPtr = clientData;
+	}
+	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;
+	    ClientData clientData = NULL;
+	    
+	    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;
+		case TCL_PLATFORM_MAC:
+		    if (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->nativePathPtr == NULL ? &clientData : NULL));
+	    fsPathPtr->normPathPtr = copy;
+	    if (clientData != NULL) {
+		fsPathPtr->nativePathPtr = clientData;
+	    }
+	}
     }
+    if (fsPathPtr->normPathPtr == NULL) {
+	ClientData clientData = 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);
 
-    /*
-     * Allow filesystems not to provide a filesystemSeparatorProc if they wish
-     * to use the standard forward slash.
+		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, 
+		       (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
+	if (0 && (clientData != NULL)) {
+	    fsPathPtr->nativePathPtr = 
+	      (*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
+	}
+	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.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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;
 
-    TclNewLiteralStringObj(resultObj, "/");
-    return resultObj;
+	proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
+	if (proc == NULL) {
+	    return NULL;
+	}
+
+	nativePathPtr = (*proc)(pathObjPtr);
+	srcFsPathPtr  = (FsPath*) PATHOBJ(pathObjPtr);
+	srcFsPathPtr->nativePathPtr = nativePathPtr;
+    }
+
+    return srcFsPathPtr->nativePathPtr;
 }
 
 /*
  *---------------------------------------------------------------------------
  *
- * NativeFilesystemSeparator --
+ * TclFSEnsureEpochOk --
  *
- *	This function is part of the native filesystem support, and returns
- *	the separator for the given path.
+ *      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:
- *	String object containing the separator character.
+ *      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.
@@ -4739,27 +6108,451 @@ Tcl_FSPathSeparator(
  *---------------------------------------------------------------------------
  */
 
-static Tcl_Obj *
-NativeFilesystemSeparator(
-    Tcl_Obj *pathPtr)
+int 
+Tcl_FSEqualPaths(firstPtr, secondPtr)
+    Tcl_Obj* firstPtr;
+    Tcl_Obj* secondPtr;
 {
-    const char *separator = NULL; /* lint */
+    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='/';
+	
+	if (tclPlatform==TCL_PLATFORM_MAC) {
+	    if (strchr(name, ':') != NULL) 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:
-	separator = "/";
-	break;
-    case TCL_PLATFORM_WINDOWS:
-	separator = "\\";
-	break;
+	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;
+	case TCL_PLATFORM_MAC:
+	    if (cwdStr[cwdLen-1] != ':') {
+		Tcl_AppendToObj(copy, ":", 1);
+		cwdLen++;
+	    }
+	    break;
     }
-    return Tcl_NewStringObj(separator,1);
+    Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
+    objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
+    objPtr->length = cwdLen;
+    copy->bytes = tclEmptyStringRep;
+    copy->length = 0;
+    Tcl_DecrRefCount(copy);
 }
 
 /*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
+ *---------------------------------------------------------------------------
+ *
+ * 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 b206b35..79fc262 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -1,135 +1,122 @@
-/*
+/* 
  * 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. Also provides table-based argv/argc processing.
+ *	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) 1990-1994 The Regents of the University of California.
  * Copyright (c) 1997 Sun Microsystems, Inc.
- * Copyright (c) 2006 Sam Bromley.
  *
- * 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 functions defined later in this file:
+ * Prototypes for procedures defined later in this file:
  */
 
-static int		GetIndexFromObjList(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr,
-			    const char *msg, int flags, int *indexPtr);
-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);
-static int		PrefixAllObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		PrefixLongestObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		PrefixMatchObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static void		PrintUsage(Tcl_Interp *interp,
-			    const Tcl_ArgvInfo *argTable);
+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));
 
 /*
- * The structure below defines the index Tcl object type by means of functions
- * that can be invoked by generic object code.
+ * The structure below defines the index Tcl object type by means of
+ * procedures that can be invoked by generic object code.
  */
 
-static const Tcl_ObjType indexType = {
-    "index",			/* name */
-    FreeIndex,			/* freeIntRepProc */
-    DupIndex,			/* dupIntRepProc */
-    UpdateStringOfIndex,	/* updateStringProc */
-    SetIndexFromAny		/* setFromAnyProc */
+Tcl_ObjType tclIndexType = {
+    "index",				/* name */
+    FreeIndex,				/* freeIntRepProc */
+    DupIndex,				/* dupIntRepProc */
+    UpdateStringOfIndex,		/* updateStringProc */
+    SetIndexFromAny			/* setFromAnyProc */
 };
 
 /*
- * 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.otherValuePtr 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 */
-    int offset;			/* Offset between table entries */
-    int index;			/* Selected index into table. */
+    VOID *tablePtr;			/* Pointer to the table of strings */
+    int offset;				/* Offset between table entries */
+    int index;				/* Selected index into table. */
 } IndexRep;
 
 /*
  * The following macros greatly simplify moving through a table...
  */
-
 #define STRING_AT(table, offset, index) \
-	(*((const char *const *)(((char *)(table)) + ((offset) * (index)))))
+	(*((CONST char * CONST *)(((char *)(table)) + ((offset) * (index)))))
 #define NEXT_ENTRY(table, offset) \
 	(&(STRING_AT(table, offset, 1)))
 #define EXPAND_OF(indexRep) \
 	STRING_AT((indexRep)->tablePtr, (indexRep)->offset, (indexRep)->index)
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_GetIndexFromObj --
  *
- *	This function looks up an object's value in a table of strings and
- *	returns the index of the matching string, if any.
+ *	This procedure 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 tablePtr, 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(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
-    const char *const*tablePtr,	/* Array of strings to compare against the
+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
 				 * 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 == &indexType) {
-	IndexRep *indexRep = objPtr->internalRep.otherValuePtr;
-
+    if (objPtr->typePtr == &tclIndexType) {
+	IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
 	/*
-	 * 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;
 	}
@@ -141,132 +128,51 @@ Tcl_GetIndexFromObj(
 /*
  *----------------------------------------------------------------------
  *
- * GetIndexFromObjList --
- *
- *	This procedure 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 tableObjPtr, 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:
- *	Removes any internal representation that the object might have. (TODO:
- *	find a way to cache the lookup.)
- *
- *----------------------------------------------------------------------
- */
-
-int
-GetIndexFromObjList(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
-    Tcl_Obj *tableObjPtr,	/* List of strings to compare against the
-				 * value of objPtr. */
-    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 objc, result, t;
-    Tcl_Obj **objv;
-    const char **tablePtr;
-
-    /*
-     * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
-     * of the code there. This is a bit ineffiecient but simpler.
-     */
-
-    result = Tcl_ListObjGetElements(interp, tableObjPtr, &objc, &objv);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    /*
-     * Build a string table from the list.
-     */
-
-    tablePtr = ckalloc((objc + 1) * sizeof(char *));
-    for (t = 0; t < objc; t++) {
-	if (objv[t] == objPtr) {
-	    /*
-	     * An exact match is always chosen, so we can stop here.
-	     */
-
-	    ckfree(tablePtr);
-	    *indexPtr = t;
-	    return TCL_OK;
-	}
-
-	tablePtr[t] = Tcl_GetString(objv[t]);
-    }
-    tablePtr[objc] = NULL;
-
-    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
-	    sizeof(char *), msg, flags, indexPtr);
-
-    /*
-     * The internal rep must be cleared since tablePtr will go away.
-     */
-
-    TclFreeIntRep(objPtr);
-    ckfree(tablePtr);
-
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_GetIndexFromObjStruct --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	If the value of objPtr is identical to or a unique abbreviation for
- *	one of the entries in tablePtr, 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_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
+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
 				 * 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, idx, numAbbrev;
-    const char *key, *p1;
-    const char *p2;
-    const char *const *entryPtr;
+    int index, i, numAbbrev;
+    char *key, *p1;
+    CONST char *p2;
+    CONST char * CONST *entryPtr;
     Tcl_Obj *resultPtr;
     IndexRep *indexRep;
 
@@ -274,8 +180,8 @@ Tcl_GetIndexFromObjStruct(
      * See if there is a valid cached result from a previous lookup.
      */
 
-    if (objPtr->typePtr == &indexType) {
-	indexRep = objPtr->internalRep.otherValuePtr;
+    if (objPtr->typePtr == &tclIndexType) {
+	indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
 	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
 	    *indexPtr = indexRep->index;
 	    return TCL_OK;
@@ -283,7 +189,7 @@ Tcl_GetIndexFromObjStruct(
     }
 
     /*
-     * 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.
      */
 
@@ -297,89 +203,82 @@ Tcl_GetIndexFromObjStruct(
      *  - A single abbreviation (allowed depending on flags)
      *  - Several abbreviations (never allowed, but overridden by exact match)
      */
-
-    for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL;
-	    entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
+    for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; 
+	    entryPtr = NEXT_ENTRY(entryPtr, offset), i++) {
 	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
 	    if (*p1 == '\0') {
-		index = idx;
+		index = i;
 		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 = idx;
+	    index = i;
 	}
     }
-
     /*
-     * 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 == &indexType) {
-	indexRep = objPtr->internalRep.otherValuePtr;
+    if (objPtr->typePtr == &tclIndexType) {
+ 	indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
     } else {
-	TclFreeIntRep(objPtr);
-	indexRep = ckalloc(sizeof(IndexRep));
-	objPtr->internalRep.otherValuePtr = indexRep;
-	objPtr->typePtr = &indexType;
-    }
-    indexRep->tablePtr = (void *) tablePtr;
+ 	if ((objPtr->typePtr != NULL)
+		&& (objPtr->typePtr->freeIntRepProc != NULL)) {
+ 	    objPtr->typePtr->freeIntRepProc(objPtr);
+ 	}
+ 	indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
+ 	objPtr->internalRep.otherValuePtr = (VOID *) indexRep;
+ 	objPtr->typePtr = &tclIndexType;
+    }
+    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;
 
 	TclNewObj(resultPtr);
-	Tcl_AppendStringsToObj(resultPtr,
-		(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
-		msg, " \"", key, NULL);
-	if (STRING_AT(tablePtr, offset, 0) == NULL) {
-	    Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
-	} else {
-	    Tcl_AppendStringsToObj(resultPtr, "\": must be ",
-		    STRING_AT(tablePtr, offset, 0), NULL);
-	    for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
-		    *entryPtr != NULL;
-		    entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
-		if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
-		    Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
-			    " or ", *entryPtr, NULL);
-		} else {
-		    Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
-		}
+	Tcl_SetObjResult(interp, resultPtr);
+	Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) &&
+		!(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"",
+		key, "\": must be ", STRING_AT(tablePtr,offset,0), (char*)NULL);
+	for (entryPtr = NEXT_ENTRY(tablePtr, offset), count = 0;
+		*entryPtr != NULL;
+		entryPtr = NEXT_ENTRY(entryPtr, offset), count++) {
+	    if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
+		Tcl_AppendStringsToObj(resultPtr,
+			(count > 0) ? ", or " : " or ", *entryPtr,
+			(char *) NULL);
+	    } else {
+		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr,
+			(char *) NULL);
 	    }
 	}
-	Tcl_SetObjResult(interp, resultPtr);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
     }
     return TCL_ERROR;
 }
@@ -389,14 +288,14 @@ Tcl_GetIndexFromObjStruct(
  *
  * SetIndexFromAny --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -405,14 +304,14 @@ Tcl_GetIndexFromObjStruct(
  */
 
 static int
-SetIndexFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
+SetIndexFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
 {
     if (interp) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+    Tcl_AppendToObj(Tcl_GetObjResult(interp),
 	    "can't convert value to index except via Tcl_GetIndexFromObj API",
-	    -1));
+	    -1);
     }
     return TCL_ERROR;
 }
@@ -422,8 +321,9 @@ SetIndexFromAny(
  *
  * UpdateStringOfIndex --
  *
- *	This function is called to convert a Tcl object from index internal
- *	form to its string form. No abbreviation is ever generated.
+ *	This procedure is called to convert a Tcl object from index
+ *	internal form to its string form.  No abbreviation is ever
+ *	generated.
  *
  * Results:
  *	None.
@@ -435,16 +335,16 @@ SetIndexFromAny(
  */
 
 static void
-UpdateStringOfIndex(
-    Tcl_Obj *objPtr)
+UpdateStringOfIndex(objPtr)
+    Tcl_Obj *objPtr;
 {
-    IndexRep *indexRep = objPtr->internalRep.otherValuePtr;
+    IndexRep *indexRep = (IndexRep *) objPtr->internalRep.otherValuePtr;
     register char *buf;
     register unsigned len;
-    register const char *indexStr = EXPAND_OF(indexRep);
+    register CONST char *indexStr = EXPAND_OF(indexRep);
 
     len = strlen(indexStr);
-    buf = ckalloc(len + 1);
+    buf = (char *) ckalloc(len + 1);
     memcpy(buf, indexStr, len+1);
     objPtr->bytes = buf;
     objPtr->length = len;
@@ -455,30 +355,29 @@ UpdateStringOfIndex(
  *
  * DupIndex --
  *
- *	This function is called to copy the internal rep of an index Tcl
- *	object from to another object.
+ *	This procedure 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(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *dupPtr)
+DupIndex(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr, *dupPtr;
 {
-    IndexRep *srcIndexRep = srcPtr->internalRep.otherValuePtr;
-    IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
+    IndexRep *srcIndexRep = (IndexRep *) srcPtr->internalRep.otherValuePtr;
+    IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
 
     memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
-    dupPtr->internalRep.otherValuePtr = dupIndexRep;
-    dupPtr->typePtr = &indexType;
+    dupPtr->internalRep.otherValuePtr = (VOID *) dupIndexRep;
+    dupPtr->typePtr = &tclIndexType;
 }
 
 /*
@@ -486,8 +385,8 @@ DupIndex(
  *
  * FreeIndex --
  *
- *	This function is called to delete the internal rep of an index Tcl
- *	object.
+ *	This procedure is called to delete the internal rep of an index
+ *	Tcl object.
  *
  * Results:
  *	None.
@@ -499,320 +398,10 @@ DupIndex(
  */
 
 static void
-FreeIndex(
-    Tcl_Obj *objPtr)
-{
-    ckfree(objPtr->internalRep.otherValuePtr);
-    objPtr->typePtr = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitPrefixCmd --
- *
- *	This procedure creates the "prefix" Tcl command. See the user
- *	documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Command
-TclInitPrefixCmd(
-    Tcl_Interp *interp)		/* Current interpreter. */
-{
-    static const EnsembleImplMap prefixImplMap[] = {
-	{"all",		PrefixAllObjCmd, NULL, NULL, NULL, 0},
-	{"longest",	PrefixLongestObjCmd, NULL, NULL, NULL, 0},
-	{"match",	PrefixMatchObjCmd, NULL, NULL, NULL, 0},
-	{NULL, NULL, NULL, NULL, NULL, 0}
-    };
-    Tcl_Command prefixCmd;
-
-    prefixCmd = TclMakeEnsemble(interp, "::tcl::prefix", prefixImplMap);
-    Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
-	    "prefix", 0);
-    return prefixCmd;
-}
-
-/*----------------------------------------------------------------------
- *
- * PrefixMatchObjCmd --
- *
- *	This function implements the 'prefix match' Tcl command. Refer to the
- *	user documentation for details on what it does.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PrefixMatchObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    int flags = 0, result, index;
-    int dummyLength, i, errorLength;
-    Tcl_Obj *errorPtr = NULL;
-    const char *message = "option";
-    Tcl_Obj *tablePtr, *objPtr, *resultPtr;
-    static const char *const matchOptions[] = {
-	"-error", "-exact", "-message", NULL
-    };
-    enum matchOptions {
-	PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE
-    };
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?options? table string");
-	return TCL_ERROR;
-    }
-
-    for (i = 1; i < (objc - 2); i++) {
-	if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0,
-		&index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch ((enum matchOptions) index) {
-	case PRFMATCH_EXACT:
-	    flags |= TCL_EXACT;
-	    break;
-	case PRFMATCH_MESSAGE:
-	    if (i > (objc - 4)) {
-		Tcl_AppendResult(interp, "missing message", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
-		return TCL_ERROR;
-	    }
-	    i++;
-	    message = Tcl_GetString(objv[i]);
-	    break;
-	case PRFMATCH_ERROR:
-	    if (i > objc-4) {
-		Tcl_AppendResult(interp, "missing error options", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
-		return TCL_ERROR;
-	    }
-	    i++;
-	    result = Tcl_ListObjLength(interp, objv[i], &errorLength);
-	    if (result != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if ((errorLength % 2) != 0) {
-		Tcl_AppendResult(interp, "error options must have an even"
-			" number of elements", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
-		return TCL_ERROR;
-	    }
-	    errorPtr = objv[i];
-	    break;
-	}
-    }
-
-    tablePtr = objv[objc - 2];
-    objPtr = objv[objc - 1];
-
-    /*
-     * Check that table is a valid list first, since we want to handle that
-     * error case regardless of level.
-     */
-
-    result = Tcl_ListObjLength(interp, tablePtr, &dummyLength);
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    result = GetIndexFromObjList(interp, objPtr, tablePtr, message, flags,
-	    &index);
-    if (result != TCL_OK) {
-	if (errorPtr != NULL && errorLength == 0) {
-	    Tcl_ResetResult(interp);
-	    return TCL_OK;
-	} else if (errorPtr == NULL) {
-	    return TCL_ERROR;
-	}
-
-	if (Tcl_IsShared(errorPtr)) {
-	    errorPtr = Tcl_DuplicateObj(errorPtr);
-	}
-	Tcl_ListObjAppendElement(interp, errorPtr,
-		Tcl_NewStringObj("-code", 5));
-	Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result));
-
-	return Tcl_SetReturnOptions(interp, errorPtr);
-    }
-
-    result = Tcl_ListObjIndex(interp, tablePtr, index, &resultPtr);
-    if (result != TCL_OK) {
-	return result;
-    }
-    Tcl_SetObjResult(interp, resultPtr);
-    return TCL_OK;
-}
-
-/*----------------------------------------------------------------------
- *
- * PrefixAllObjCmd --
- *
- *	This function implements the 'prefix all' Tcl command. Refer to the
- *	user documentation for details on what it does.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PrefixAllObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    int tableObjc, result, t, length, elemLength;
-    const char *string, *elemString;
-    Tcl_Obj **tableObjv, *resultPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "table string");
-	return TCL_ERROR;
-    }
-
-    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
-    if (result != TCL_OK) {
-	return result;
-    }
-    resultPtr = Tcl_NewListObj(0, NULL);
-    string = Tcl_GetStringFromObj(objv[2], &length);
-
-    for (t = 0; t < tableObjc; t++) {
-	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
-
-	/*
-	 * A prefix cannot match if it is longest.
-	 */
-
-	if (length <= elemLength) {
-	    if (TclpUtfNcmp2(elemString, string, length) == 0) {
-		Tcl_ListObjAppendElement(interp, resultPtr, tableObjv[t]);
-	    }
-	}
-    }
-
-    Tcl_SetObjResult(interp, resultPtr);
-    return TCL_OK;
-}
-
-/*----------------------------------------------------------------------
- *
- * PrefixLongestObjCmd --
- *
- *	This function implements the 'prefix longest' Tcl command. Refer to
- *	the user documentation for details on what it does.
- *
- * Results:
- *	Returns a standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-PrefixLongestObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+FreeIndex(objPtr)
+    Tcl_Obj *objPtr;
 {
-    int tableObjc, result, i, t, length, elemLength, resultLength;
-    const char *string, *elemString, *resultString;
-    Tcl_Obj **tableObjv;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "table string");
-	return TCL_ERROR;
-    }
-
-    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
-    if (result != TCL_OK) {
-	return result;
-    }
-    string = Tcl_GetStringFromObj(objv[2], &length);
-
-    resultString = NULL;
-    resultLength = 0;
-
-    for (t = 0; t < tableObjc; t++) {
-	elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
-
-	/*
-	 * First check if the prefix string matches the element. A prefix
-	 * cannot match if it is longest.
-	 */
-
-	if ((length > elemLength) ||
-		TclpUtfNcmp2(elemString, string, length) != 0) {
-	    continue;
-	}
-
-	if (resultString == NULL) {
-	    /*
-	     * If this is the first match, the longest common substring this
-	     * far is the complete string. The result is part of this string
-	     * so we only need to adjust the length later.
-	     */
-
-	    resultString = elemString;
-	    resultLength = elemLength;
-	} else {
-	    /*
-	     * Longest common substring cannot be longer than shortest string.
-	     */
-
-	    if (elemLength < resultLength) {
-		resultLength = elemLength;
-	    }
-
-	    /*
-	     * Compare strings.
-	     */
-
-	    for (i = 0; i < resultLength; i++) {
-		if (resultString[i] != elemString[i]) {
-		    /*
-		     * Adjust in case we stopped in the middle of a UTF char.
-		     */
-
-		    resultLength = Tcl_UtfPrev(&resultString[i+1],
-			    resultString) - resultString;
-		    break;
-		}
-	    }
-	}
-    }
-    if (resultLength > 0) {
-	Tcl_SetObjResult(interp,
-		Tcl_NewStringObj(resultString, resultLength));
-    }
-    return TCL_OK;
+    ckfree((char *) objPtr->internalRep.otherValuePtr);
 }
 
 /*
@@ -820,658 +409,70 @@ PrefixLongestObjCmd(
  *
  * Tcl_WrongNumArgs --
  *
- *	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.
+ *	This procedure generates a "wrong # args" error message in an
+ *	interpreter.  It is used as a utility function by many command
+ *	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.
- *
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 void
-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_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_Obj *objPtr;
-    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 */
+    int i;
+    register IndexRep *indexRep;
 
     TclNewObj(objPtr);
-    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
-	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.otherValuePtr;
-
-		elementStr = EXPAND_OF(indexRep);
-		elemLen = strlen(elementStr);
-	    } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
-		register EnsembleCmdRep *ecrPtr =
-			origObjv[i]->internalRep.otherValuePtr;
-
-		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:
+    Tcl_SetObjResult(interp, objPtr);
+    Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
     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 == &indexType) {
-	    register IndexRep *indexRep = objv[i]->internalRep.otherValuePtr;
-
-	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
-	} else if (objv[i]->typePtr == &tclEnsembleCmdType) {
-	    register EnsembleCmdRep *ecrPtr =
-		    objv[i]->internalRep.otherValuePtr;
-
-	    Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
+	
+	if (objv[i]->typePtr == &tclIndexType) {
+	    indexRep = (IndexRep *) objv[i]->internalRep.otherValuePtr;
+	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), (char *) NULL);
 	} else {
-	    /*
-	     * 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);
-	    }
+	    Tcl_AppendStringsToObj(objPtr, Tcl_GetString(objv[i]),
+		    (char *) NULL);
 	}
 
-	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!=NULL) {
-	    Tcl_AppendStringsToObj(objPtr, " ", NULL);
+	if ((i < (objc - 1)) || message) {
+	    Tcl_AppendStringsToObj(objPtr, " ", (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);
+    if (message) {
+	Tcl_AppendStringsToObj(objPtr, message, (char *) NULL);
     }
-    Tcl_AppendStringsToObj(objPtr, "\"", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
-    Tcl_SetObjResult(interp, objPtr);
-#undef MAY_QUOTE_WORD
-#undef AFTER_FIRST_WORD
+    Tcl_AppendStringsToObj(objPtr, "\"", (char *) NULL);
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ParseArgsObjv --
- *
- *	Process an objv array according to a table of expected command-line
- *	options. See the manual page for more details.
- *
- * Results:
- *	The return value is a standard Tcl return value. If an error occurs
- *	then an error message is left in the interp's result. Under normal
- *	conditions, both *objcPtr and *objv are modified to return the
- *	arguments that couldn't be processed here (they didn't match the
- *	option table, or followed an TCL_ARGV_REST argument).
- *
- * Side effects:
- *	Variables may be modified, or procedures may be called. It all depends
- *	on the arguments and their entries in argTable. See the user
- *	documentation for details.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ParseArgsObjv(
-    Tcl_Interp *interp,		/* Place to store error message. */
-    const Tcl_ArgvInfo *argTable,
-				/* Array of option descriptions. */
-    int *objcPtr,		/* Number of arguments in objv. Modified to
-				 * hold # args left in objv at end. */
-    Tcl_Obj *const *objv,	/* Array of arguments to be parsed. */
-    Tcl_Obj ***remObjv)		/* Pointer to array of arguments that were not
-				 * processed here. Should be NULL if no return
-				 * of arguments is desired. */
-{
-    Tcl_Obj **leftovers;	/* Array to write back to remObjv on
-				 * successful exit. Will include the name of
-				 * the command. */
-    int nrem;			/* Size of leftovers.*/
-    register const Tcl_ArgvInfo *infoPtr;
-				/* Pointer to the current entry in the table
-				 * of argument descriptions. */
-    const Tcl_ArgvInfo *matchPtr;
-				/* Descriptor that matches current argument */
-    Tcl_Obj *curArg;		/* Current argument */
-    const char *str = NULL;
-    register char c;		/* Second character of current arg (used for
-				 * quick check for matching; use 2nd char.
-				 * because first char. will almost always be
-				 * '-'). */
-    int srcIndex;		/* Location from which to read next argument
-				 * from objv. */
-    int dstIndex;		/* Used to keep track of current arguments
-				 * being processed, primarily for error
-				 * reporting. */
-    int objc;			/* # arguments in objv still to process. */
-    int length;			/* Number of characters in current argument */
-
-    if (remObjv != NULL) {
-	/*
-	 * Then we should copy the name of the command (0th argument). The
-	 * upper bound on the number of elements is known, and (undocumented,
-	 * but historically true) there should be a NULL argument after the
-	 * last result. [Bug 3413857]
-	 */
-
-	nrem = 1;
-	leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
-	leftovers[0] = objv[0];
-    } else {
-	nrem = 0;
-	leftovers = NULL;
-    }
-
-    /*
-     * OK, now start processing from the second element (1st argument).
-     */
-
-    srcIndex = dstIndex = 1;
-    objc = *objcPtr-1;
-
-    while (objc > 0) {
-	curArg = objv[srcIndex];
-	srcIndex++;
-	objc--;
-	str = Tcl_GetStringFromObj(curArg, &length);
-	if (length > 0) {
-	    c = str[1];
-	} else {
-	    c = 0;
-	}
-
-	/*
-	 * Loop throught the argument descriptors searching for one with the
-	 * matching key string. If found, leave a pointer to it in matchPtr.
-	 */
-
-	matchPtr = NULL;
-	infoPtr = argTable;
-	for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) {
-	    if (infoPtr->keyStr == NULL) {
-		continue;
-	    }
-	    if ((infoPtr->keyStr[1] != c)
-		    || (strncmp(infoPtr->keyStr, str, length) != 0)) {
-		continue;
-	    }
-	    if (infoPtr->keyStr[length] == 0) {
-		matchPtr = infoPtr;
-		goto gotMatch;
-	    }
-	    if (matchPtr != NULL) {
-		Tcl_AppendResult(interp, "ambiguous option \"", str, "\"",
-			NULL);
-		goto error;
-	    }
-	    matchPtr = infoPtr;
-	}
-	if (matchPtr == NULL) {
-	    /*
-	     * Unrecognized argument. Just copy it down, unless the caller
-	     * prefers an error to be registered.
-	     */
-
-	    if (remObjv == NULL) {
-		Tcl_AppendResult(interp, "unrecognized argument \"", str,
-			"\"", NULL);
-		goto error;
-	    }
-
-	    dstIndex++;		/* This argument is now handled */
-	    leftovers[nrem++] = curArg;
-	    continue;
-	}
-
-	/*
-	 * Take the appropriate action based on the option type
-	 */
-
-    gotMatch:
-	infoPtr = matchPtr;
-	switch (infoPtr->type) {
-	case TCL_ARGV_CONSTANT:
-	    *((int *) infoPtr->dstPtr) = PTR2INT(infoPtr->srcPtr);
-	    break;
-	case TCL_ARGV_INT:
-	    if (objc == 0) {
-		goto missingArg;
-	    }
-	    if (Tcl_GetIntFromObj(interp, objv[srcIndex],
-		    (int *) infoPtr->dstPtr) == TCL_ERROR) {
-		Tcl_AppendResult(interp, "expected integer argument for \"",
-			infoPtr->keyStr, "\" but got \"",
-			Tcl_GetString(objv[srcIndex]), "\"", NULL);
-		goto error;
-	    }
-	    srcIndex++;
-	    objc--;
-	    break;
-	case TCL_ARGV_STRING:
-	    if (objc == 0) {
-		goto missingArg;
-	    }
-	    *((const char **) infoPtr->dstPtr) =
-		    Tcl_GetString(objv[srcIndex]);
-	    srcIndex++;
-	    objc--;
-	    break;
-	case TCL_ARGV_REST:
-	    /*
-	     * Only store the point where we got to if it's not to be written
-	     * to NULL, so that TCL_ARGV_AUTO_REST works.
-	     */
-
-	    if (infoPtr->dstPtr != NULL) {
-		*((int *) infoPtr->dstPtr) = dstIndex;
-	    }
-	    goto argsDone;
-	case TCL_ARGV_FLOAT:
-	    if (objc == 0) {
-		goto missingArg;
-	    }
-	    if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
-		    (double *) infoPtr->dstPtr) == TCL_ERROR) {
-		Tcl_AppendResult(interp, "expected floating-point argument ",
-			"for \"", infoPtr->keyStr, "\" but got \"",
-			Tcl_GetString(objv[srcIndex]), "\"", NULL);
-		goto error;
-	    }
-	    srcIndex++;
-	    objc--;
-	    break;
-	case TCL_ARGV_FUNC: {
-	    Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *)
-		    infoPtr->srcPtr;
-	    Tcl_Obj *argObj;
-
-	    if (objc == 0) {
-		argObj = NULL;
-	    } else {
-		argObj = objv[srcIndex];
-	    }
-	    if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) {
-		srcIndex++;
-		objc--;
-	    }
-	    break;
-	}
-	case TCL_ARGV_GENFUNC: {
-	    Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
-		    infoPtr->srcPtr;
-
-	    objc = handlerProc(infoPtr->clientData, interp, objc,
-		    &objv[srcIndex], infoPtr->dstPtr);
-	    if (objc < 0) {
-		goto error;
-	    }
-	    break;
-	}
-	case TCL_ARGV_HELP:
-	    PrintUsage(interp, argTable);
-	    goto error;
-	default:
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "bad argument type %d in Tcl_ArgvInfo", infoPtr->type));
-	    goto error;
-	}
-    }
-
-    /*
-     * If we broke out of the loop because of an OPT_REST argument, copy the
-     * remaining arguments down. Note that there is always at least one
-     * argument left over - the command name - so we always have a result if
-     * our caller is willing to receive it. [Bug 3413857]
-     */
-
-  argsDone:
-    if (remObjv == NULL) {
-	/*
-	 * Nothing to do.
-	 */
-
-	return TCL_OK;
-    }
-
-    if (objc > 0) {
-	memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
-	nrem += objc;
-    }
-    leftovers[nrem] = NULL;
-    *objcPtr = nrem++;
-    *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
-    return TCL_OK;
-
-    /*
-     * Make sure to handle freeing any temporary space we've allocated on the
-     * way to an error.
-     */
-
-  missingArg:
-    Tcl_AppendResult(interp, "\"", str,
-	    "\" option requires an additional argument", NULL);
-  error:
-    if (leftovers != NULL) {
-	ckfree(leftovers);
-    }
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * PrintUsage --
- *
- *	Generate a help string describing command-line options.
- *
- * Results:
- *	The interp's result will be modified to hold a help string describing
- *	all the options in argTable.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-PrintUsage(
-    Tcl_Interp *interp,		/* Place information in this interp's result
-				 * area. */
-    const Tcl_ArgvInfo *argTable)
-				/* Array of command-specific argument
-				 * descriptions. */
-{
-    register const Tcl_ArgvInfo *infoPtr;
-    int width, numSpaces;
-#define NUM_SPACES 20
-    static const char spaces[] = "                    ";
-    char tmp[TCL_DOUBLE_SPACE];
-
-    /*
-     * First, compute the width of the widest option key, so that we can make
-     * everything line up.
-     */
-
-    width = 4;
-    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
-	int length;
-
-	if (infoPtr->keyStr == NULL) {
-	    continue;
-	}
-	length = strlen(infoPtr->keyStr);
-	if (length > width) {
-	    width = length;
-	}
-    }
-
-    /*
-     * Now add the option information, with pretty-printing.
-     */
-
-    Tcl_AppendResult(interp, "Command-specific options:", NULL);
-    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
-	if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) {
-	    Tcl_AppendResult(interp, "\n", infoPtr->helpStr, NULL);
-	    continue;
-	}
-	Tcl_AppendResult(interp, "\n ", infoPtr->keyStr, ":", NULL);
-	numSpaces = width + 1 - strlen(infoPtr->keyStr);
-	while (numSpaces > 0) {
-	    if (numSpaces >= NUM_SPACES) {
-		Tcl_AppendResult(interp, spaces, NULL);
-	    } else {
-		Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces, NULL);
-	    }
-	    numSpaces -= NUM_SPACES;
-	}
-	Tcl_AppendResult(interp, infoPtr->helpStr, NULL);
-	switch (infoPtr->type) {
-	case TCL_ARGV_INT:
-	    sprintf(tmp, "%d", *((int *) infoPtr->dstPtr));
-	    Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
-	    break;
-	case TCL_ARGV_FLOAT:
-	    sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
-	    Tcl_AppendResult(interp, "\n\t\tDefault value: ", tmp, NULL);
-	    break;
-	case TCL_ARGV_STRING: {
-	    char *string;
-
-	    string = *((char **) infoPtr->dstPtr);
-	    if (string != NULL) {
-		Tcl_AppendResult(interp, "\n\t\tDefault value: \"", string,
-			"\"", NULL);
-	    }
-	    break;
-	}
-	default:
-	    break;
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetCompletionCodeFromObj --
- *
- *	Parses Completion code Code
- *
- * Results:
- *	Returns TCL_ERROR if the value is an invalid completion code.
- *	Otherwise, returns TCL_OK, and writes the completion code to
- *  the pointer provided.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclGetCompletionCodeFromObj(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    Tcl_Obj *value,
-    int *code)			/* Argument objects. */
-{
-    static const char *const returnCodes[] = {
-	"ok", "error", "return", "break", "continue", NULL
-    };
-
-    if ((value->typePtr != &indexType)
-	    && (TCL_OK == TclGetIntFromObj(NULL, value, code))) {
-	return TCL_OK;
-    }
-    if (TCL_OK == Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL,
-		TCL_EXACT, code)) {
-	return TCL_OK;
-    }
-    /*
-     * Value is not a legal completion code.
-     */
-
-    if (interp != NULL) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "bad completion code \"",
-		TclGetString(value),
-		"\": must be ok, error, return, break, "
-		"continue, or an integer", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
-    }
-    return TCL_ERROR;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclInitScript.h b/generic/tclInitScript.h
new file mode 100644
index 0000000..a3a1d6a
--- /dev/null
+++ b/generic/tclInitScript.h
@@ -0,0 +1,110 @@
+/* 
+ * 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 ad755bc..ef2f6df 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -8,7 +8,6 @@
 #
 # 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.
@@ -28,12 +27,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)
 }
@@ -41,7 +40,7 @@ declare 3 {
 #  declare 4 {
 #      int TclChdir(Tcl_Interp *interp, char *dirName)
 #  }
-declare 5 {
+declare 5 {unix win} {
     int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
 	    Tcl_Channel errorChan)
 }
@@ -52,13 +51,13 @@ declare 7 {
     int TclCopyAndCollapse(int count, const char *src, char *dst)
 }
 declare 8 {
-    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
+    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
 	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
 }
 
 # TclCreatePipeline unofficially exported for use by BLT.
 
-declare 9 {
+declare 9 {unix win} {
     int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv,
 	    Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr,
 	    TclFile *errFilePtr)
@@ -72,15 +71,14 @@ declare 11 {
     void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr)
 }
 declare 12 {
-    void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
+    void TclDeleteVars(Interp *iPtr, Tcl_HashTable *tablePtr)
+}
+declare 13 {
+    int TclDoGlob(Tcl_Interp *interp, char *separators,
+	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
 }
-# Removed in 8.5
-#declare 13 {
-#    int TclDoGlob(Tcl_Interp *interp, char *separators,
-#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
-#}
 declare 14 {
-    int TclDumpMemoryInfo(ClientData clientData, int flags)
+    void TclDumpMemoryInfo(FILE *outFile)
 }
 # Removed in 8.1:
 #  declare 15 {
@@ -113,7 +111,6 @@ 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)
 }
@@ -124,11 +121,10 @@ declare 25 {
 #  declare 26 {
 #      char *TclGetCwd(Tcl_Interp *interp)
 #  }
-# Removed in 8.5
-#declare 27 {
-#    int TclGetDate(char *p, Tcl_WideInt now, long zone,
-#	    Tcl_WideInt *timePtr)
-#}
+declare 27 {
+    int TclGetDate(char *p, Tcl_WideInt now, long zone,
+	    Tcl_WideInt *timePtr)
+}
 declare 28 {
     Tcl_Channel TclpGetDefaultStdChannel(int type)
 }
@@ -142,16 +138,15 @@ declare 28 {
 #      char *TclGetEnv(const char *name)
 #  }
 declare 31 {
-    const char *TclGetExtension(const char *name)
+    char *TclGetExtension(char *name)
 }
 declare 32 {
     int TclGetFrame(Tcl_Interp *interp, const char *str,
 	    CallFrame **framePtrPtr)
 }
-# Removed in Tcl 8.5
-#declare 33 {
-#    TclCmdProcType TclGetInterpProc(void)
-#}
+declare 33 {
+    TclCmdProcType TclGetInterpProc(void)
+}
 declare 34 {
     int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
 	    int endValue, int *indexPtr)
@@ -161,12 +156,11 @@ declare 34 {
 #    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
 #	    int flags)
 #}
-# Removed in 8.6a2
-#declare 36 {
-#    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
-#}
+declare 36 {
+    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
+}
 declare 37 {
-    int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
+    int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
 }
 declare 38 {
     int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
@@ -184,13 +178,11 @@ declare 41 {
     Tcl_Command TclGetOriginalCommand(Tcl_Command command)
 }
 declare 42 {
-    CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
+    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, const char **argv,
-#	    int flags)
-#}
 declare 44 {
     int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr)
 }
@@ -210,10 +202,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)
@@ -221,11 +213,9 @@ declare 50 {
 declare 51 {
     int TclInterpInit(Tcl_Interp *interp)
 }
-# Removed in Tcl 8.5a2
-#declare 52 {
-#    int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
-#	    int flags)
-#}
+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)
@@ -274,17 +264,16 @@ declare 64 {
     int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
 	    int flags)
 }
-# 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)
-#}
+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)
@@ -319,10 +308,9 @@ declare 76 {
 declare 77 {
     void TclpGetTime(Tcl_Time *time)
 }
-# Removed in 8.6:
-#declare 78 {
-#    int TclpGetTimeZone(unsigned long time)
-#}
+declare 78 {
+    int TclpGetTimeZone(Tcl_WideInt time)
+}
 # Replaced by Tcl_FSListVolumes in 8.4:
 #declare 79 {
 #    int TclpListVolumes(Tcl_Interp *interp)
@@ -381,18 +369,17 @@ declare 92 {
 declare 93 {
     void TclProcDeleteProc(ClientData clientData)
 }
-# Removed in Tcl 8.5:
-#declare 94 {
-#    int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
-#	    int argc, const char **argv)
-#}
+declare 94 {
+    int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
+	    int argc, CONST84 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, const char *oldName,
-            const char *newName)
+    int TclRenameCommand(Tcl_Interp *interp, char *oldName,
+            char *newName)
 }
 declare 97 {
     void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr)
@@ -411,31 +398,31 @@ declare 98 {
 #	    Tcl_Obj *objPtr, int flags)
 #}
 declare 101 {
-    CONST86 char *TclSetPreInitScript(const char *string)
+    char *TclSetPreInitScript(char *string)
 }
 declare 102 {
     void TclSetupEnv(Tcl_Interp *interp)
 }
 declare 103 {
-    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
+    int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto,
 	    int *portPtr)
 }
-declare 104 {
+declare 104 {unix win} {
     int TclSockMinimumBuffersOld(int sock, int size)
 }
-declare 110 {
+declare 110 {unix win} {
     int TclSockMinimumBuffers(void *sock, int size)
 }
 # Replaced by Tcl_FSStat in 8.4:
 #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)
 }
@@ -534,16 +521,15 @@ declare 132 {
     int TclpHasSockets(Tcl_Interp *interp)
 }
 declare 133 {
-    struct tm *TclpGetDate(const time_t *time, int useGMT)
+    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)
 }
-# 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:
 
@@ -558,9 +544,9 @@ declare 138 {
 #	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
 #	    Tcl_PackageInitProc **proc2Ptr, ClientData *clientDataPtr)
 #}
-#declare 140 {
-#    int TclLooksLikeInt(const char *bytes, int length)
-#}
+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)
@@ -578,7 +564,7 @@ declare 144 {
 	    int index)
 }
 declare 145 {
-    const struct AuxDataType *TclGetAuxDataType(const char *typeName)
+    struct AuxDataType *TclGetAuxDataType(char *typeName)
 }
 declare 146 {
     TclHandle TclHandleCreate(void *ptr)
@@ -626,14 +612,12 @@ declare 156 {
 declare 157 {
     Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
 }
-# REMOVED - use public Tcl_SetStartupScript()
-#declare 158 {
-#    void TclSetStartupScriptFileName(const char *filename)
-#}
-# REMOVED - use public Tcl_GetStartupScript()
-#declare 159 {
-#    const char *TclGetStartupScriptFileName(void)
-#}
+declare 158 {
+    void TclSetStartupScriptFileName(const char *filename)
+}
+declare 159 {
+    CONST84_RETURN char *TclGetStartupScriptFileName(void)
+}
 #declare 160 {
 #    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
 #	    Tcl_DString *dirPtr, char *pattern, char *tail,
@@ -655,7 +639,7 @@ declare 162 {
 # correct type when calling this procedure.
 
 declare 163 {
-    const void *TclGetInstructionTable(void)
+    void *TclGetInstructionTable(void)
 }
 
 # ALERT: The argument of 'TclExpandCodeArray' is actually a
@@ -678,14 +662,12 @@ declare 166 {
 }
 
 # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
-# REMOVED - use public Tcl_SetStartupScript()
-#declare 167 {
-#    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
-#}
-# REMOVED - use public Tcl_GetStartupScript()
-#declare 168 {
-#    Tcl_Obj *TclGetStartupScriptPath(void)
-#}
+declare 167 {
+    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
+}
+declare 168 {
+    Tcl_Obj *TclGetStartupScriptPath(void)
+}
 # variant of Tcl_UtfNCmp that takes n as bytes, not chars
 declare 169 {
     int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
@@ -708,301 +690,139 @@ declare 172 {
 
 declare 173 {
     int TclUniCharMatch(const Tcl_UniChar *string, int strLen,
-	    const Tcl_UniChar *pattern, int ptnLen, int flags)
+	    const Tcl_UniChar *pattern, int ptnLen, int nocase)
 }
 
-# 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)
-}
-# TIP 338 made these public - now declared in tcl.h
-#declare 178 {
-#    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
-#}
-#declare 179 {
-#    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
-#}
-
 # TclpGmtime and TclpLocaltime promoted to the generic interface from unix
 
 declare 182 {
-     struct tm *TclpLocaltime(const time_t *clock)
+     struct tm *TclpLocaltime(TclpTime_t_CONST clock)
 }
 declare 183 {
-     struct tm *TclpGmtime(const time_t *clock)
+     struct tm *TclpGmtime(TclpTime_t_CONST clock)
 }
 
-# For the new "Thread Storage" subsystem.
+declare 199 {
+    int TclMatchIsTrivial(const char *pattern)
+}
 
-### 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)
-}
+# Define the platform specific internal Tcl interface. These functions are
+# only available on the designated platform.
 
-#declare 199 {
-#    int TclMatchIsTrivial(const char *pattern)
-#}
+interface tclIntPlat
 
-# 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)
+########################
+# Mac specific internals
+
+declare 0 mac {
+    void *TclpSysAlloc(long size, int isBin)
 }
-# 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 1 mac {
+    void TclpSysFree(void *ptr)
 }
-declare 213 {
-    Tcl_Obj *TclGetObjNameOfExecutable(void)
+declare 2 mac {
+    void *TclpSysRealloc(void *cp, unsigned int size)
 }
-declare 214 {
-    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
+declare 3 mac {
+    void TclpExit(int status)
 }
-declare 215 {
-    void *TclStackAlloc(Tcl_Interp *interp, int numBytes)
+
+# Prototypes for functions found in the tclMacUtil.c compatability library.
+
+declare 4 mac {
+    int FSpGetDefaultDir(FSSpecPtr theSpec)
 }
-declare 216 {
-    void TclStackFree(Tcl_Interp *interp, void *freePtr)
+declare 5 mac {
+    int FSpSetDefaultDir(FSSpecPtr theSpec)
 }
-declare 217 {
-    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
-            Tcl_Namespace *namespacePtr, int isProcCallFrame)
+declare 6 mac {
+    OSErr FSpFindFolder(short vRefNum, OSType folderType,
+	    Boolean createFolder, FSSpec *spec)
 }
-declare 218 {
-    void TclPopStackFrame(Tcl_Interp *interp)
+declare 7 mac {
+    void GetGlobalMouseTcl(Point *mouse)
 }
 
-# for use in tclTest.c
-declare 224 {
-    TclPlatformType *TclGetPlatform(void)
-}
+# The following routines are utility functions in Tcl.  They are exported
+# here because they are needed in Tk.  They are not officially supported,
+# however.  The first set are from the MoreFiles package.
 
-#
-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[])
-}
-#  Used to be needed for TclOO-extension; unneeded now that TclOO is in the
-#  core and NRE-enabled
-#  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 8 mac {
+    pascal OSErr FSpGetDirectoryIDTcl(const FSSpec *spec, long *theDirID,
+	    Boolean *isDirectory)
 }
-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 9 mac {
+    pascal short FSpOpenResFileCompatTcl(const FSSpec *spec,
+	    SignedByte permission)
 }
-declare 231 {
-    int	TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-	    Tcl_Namespace **nsPtrPtr)
+declare 10 mac {
+    pascal void FSpCreateResFileCompatTcl(const FSSpec *spec, OSType creator,
+	    OSType fileType, ScriptCode scriptTag)
 }
 
-# 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)
-}
+# Like the MoreFiles routines these fix problems in the standard
+# Mac calls.  These routines are from tclMacUtils.h.
 
-# Exports for VarReform compat: Itcl, XOTcl like to peek into our varTables :(
-declare 234 {
-    Var *TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key,
-             int *newPtr)
+declare 11 mac {
+    int FSpLocationFromPath(int length, const char *path, FSSpecPtr theSpec)
 }
-declare 235 {
-    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
+declare 12 mac {
+    OSErr FSpPathFromLocation(FSSpecPtr theSpec, int *length,
+	    Handle *fullPath)
 }
 
+# Prototypes of Mac only internal functions.
 
-# TIP 337 made this one public
-#declare 236 {
-#    void TclBackgroundException(Tcl_Interp *interp, int code)
-#}
-
-# TIP #285: Script cancellation support.
-declare 237 {
-    int TclResetCancellation(Tcl_Interp *interp, int force)
-}
-
-# NRE functions for "rogue" extensions to exploit NRE; they will need to
-# include NRE.h too.
-declare 238 {
-    int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp,
-	    int objc, Tcl_Obj *const objv[])
+declare 13 mac {
+    void TclMacExitHandler(void)
 }
-declare 239 {
-    int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
-			    int skip, ProcErrorProc *errorProc)
+declare 14 mac {
+    void TclMacInitExitToShell(int usePatch)
 }
-declare 240 {
-    int TclNRRunCallbacks(Tcl_Interp *interp, int result,
-	      struct NRE_callback *rootPtr)
+declare 15 mac {
+    OSErr TclMacInstallExitToShellPatch(ExitToShellProcPtr newProc)
 }
-declare 241 {
-    int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
-	    const CmdFrame *invoker, int word)
+declare 16 mac {
+    int TclMacOSErrorToPosixError(int error)
 }
-declare 242 {
-    int TclNREvalObjv(Tcl_Interp *interp, int objc,
-	      Tcl_Obj *const objv[], int flags, Command *cmdPtr)
+declare 17 mac {
+    void TclMacRemoveTimer(void *timerToken)
 }
-
-# Tcl_Obj leak detection support.
-declare 243 {
-    void TclDbDumpActiveObjects(FILE *outFile)
-}
-
-# Functions to make things better for itcl
-declare 244 {
-    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
+declare 18 mac {
+    void *TclMacStartTimer(long ms)
 }
-declare 245 {
-    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
+declare 19 mac {
+    int TclMacTimerExpired(void *timerToken)
 }
-declare 246 {
-    int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved,
-	    int numInserted, Tcl_Obj *const *objv)
+declare 20 mac {
+    int TclMacRegisterResourceFork(short fileRef, Tcl_Obj *tokenPtr,
+	    int insert)
+}	
+declare 21 mac {
+    short TclMacUnRegisterResourceFork(char *tokenPtr, Tcl_Obj *resultPtr)
+}	
+declare 22 mac {
+    int TclMacCreateEnv(void)
 }
-declare 247 {
-    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
+declare 23 mac {
+    FILE *TclMacFOpenHack(const char *path, const char *mode)
 }
-
-declare 248 {
-    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
-	    Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
+# Replaced in 8.1 by TclpReadLink:
+#  declare 24 mac {
+#      int TclMacReadlink(char *path, char *buf, int size)
+#  }
+declare 24 mac {
+    char *TclpGetTZName(int isdst)
 }
-
-declare 249 {
-    char *TclDoubleDigits(double dv, int ndigits, int flags,
-			  int *decpt, int *signum, char **endPtr)
+declare 25 mac {
+    int TclMacChmod(const char *path, int mode)
 }
-# TIP #285: Script cancellation support.
-declare 250 {
-    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
+# version of FSpLocationFromPath that doesn't resolve the last path component
+declare 26 mac {
+    int FSpLLocationFromPath(int length, const char *path, FSSpecPtr theSpec)
 }
-
-##############################################################################
-
-# Define the platform specific internal Tcl interface. These functions are
-# only available on the designated platform.
-
-interface tclIntPlat
 
 ################################
 # Windows specific functions
@@ -1092,17 +912,15 @@ declare 20 win {
 declare 22 win {
     TclFile TclpCreateTempFile(const char *contents)
 }
-# Removed in 8.6:
-#declare 23 win {
-#    char *TclpGetTZName(int isdst)
-#}
+declare 23 win {
+    char *TclpGetTZName(int isdst)
+}
 declare 24 win {
     char *TclWinNoBackslash(char *path)
 }
-# replaced by generic TclGetPlatform
-#declare 25 win {
-#    TclPlatformType *TclWinGetPlatform(void)
-#}
+declare 25 win {
+    TclPlatformType *TclWinGetPlatform(void)
+}
 declare 26 win {
     void TclWinSetInterfaces(int wide)
 }
@@ -1183,49 +1001,30 @@ declare 10 unix {
 # generic Stubs
 # On cygwin, this is actually a reference to TclGetAndDetachPids
 declare 11 unix {
-    struct tm *TclpLocaltime_unix(const time_t *clock)
+    struct tm *TclpLocaltime_unix(TclpTime_t_CONST clock)
 }
 # On cygwin, this is actually a reference to TclpCloseFile
 declare 12 unix {
-    struct tm *TclpGmtime_unix(const time_t *clock)
+    struct tm *TclpGmtime_unix(TclpTime_t_CONST clock)
 }
 # On cygwin, this is a reference to TclpCreateCommandChannel
 # Otherwise, this is a reference to TclpInetNtoa
 declare 13 unix {
     void TclIntPlatReserved13(void)
 }
-
-# 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
-
 #On cygwin, TclpCreateProcess is here
-declare 15 {unix macosx} {
+declare 15 unix {
     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)
-}
 #On cygwin, TclpMakeFile is here
-declare 18 {unix macosx} {
+declare 18 unix {
     int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
 	    const char *fileName, Tcl_StatBuf *statBufPtr,
 	    Tcl_GlobTypeData *types)
 }
 #On cygwin, TclpOpenFile is here
-declare 19 {unix macosx} {
+declare 19 unix {
     void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
 }
 declare 20 unix {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9068dfb..20c1155 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -9,37 +9,36 @@
  * 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>
- * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
- * Copyright (c) 2008 by Miguel Sofer. 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 _TCLINT
 #define _TCLINT
 
 /*
- * Some numerics configuration options.
+ * 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.
  */
 
-#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"
+#ifndef _TCL
+#include "tcl.h"
+#endif
 
 #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
@@ -50,14 +49,9 @@
 #else
 #include <string.h>
 #endif
-#ifdef STDC_HEADERS
-#include <stddef.h>
-#else
-typedef int ptrdiff_t;
-#endif
 
 /*
- * Ensure WORDS_BIGENDIAN is defined correctly:
+ * Ensure WORDS_BIGENDIAN is defined correcly:
  * Needs to happen here in addition to configure to work with fat compiles on
  * Darwin (where configure runs only once for multiple architectures).
  */
@@ -70,15 +64,15 @@ typedef int ptrdiff_t;
 #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
 
@@ -95,83 +89,66 @@ typedef int ptrdiff_t;
 #   endif
 #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
+#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
 
 /*
- * 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)(Tcl_Interp *interp,
-	struct Tcl_ResolvedVarInfo *vinfoPtr);
+typedef Tcl_Var (Tcl_ResolveRuntimeVarProc) _ANSI_ARGS_((
+    Tcl_Interp* interp, struct Tcl_ResolvedVarInfo *vinfoPtr));
 
-typedef void (Tcl_ResolveVarDeleteProc)(struct Tcl_ResolvedVarInfo *vinfoPtr);
+typedef void (Tcl_ResolveVarDeleteProc) _ANSI_ARGS_((
+    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_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
-	Tcl_Namespace *context, int flags, Tcl_Command *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) _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;
 
 /*
@@ -180,652 +157,427 @@ 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)
-
-/*
- * Define this to reduce the amount of space that the average namespace
- * consumes by only allocating the table of child namespaces when necessary.
- * Defining it breaks compatibility for Tcl extensions (e.g., itcl) which
- * reach directly into the Namespace structure.
- */
-
-#undef BREAK_NAMESPACE_COMPAT
-
 /*
  * 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. */
-#ifndef BREAK_NAMESPACE_COMPAT
-    Tcl_HashTable childTable;	/* Contains any child namespaces. Indexed by
-				 * strings; values have type (Namespace *). */
-#else
-    Tcl_HashTable *childTablePtr;
-				/* Contains any child namespaces. Indexed by
-				 * strings; values have type (Namespace *). If
-				 * NULL, there are no children. */
-#endif
-    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.*/
+				 /* 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.*/
     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. */
-    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. */
-    Tcl_NamespaceDeleteProc *earlyDeleteProc;
-				/* Just like the deleteProc field (and called
-				 * with the same clientData) but called at the
-				 * start of the deletion process, so there is
-				 * a chance for code to do stuff inside the
-				 * namespace before deletion completes. */
+				 /* 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. */
 } 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
- *		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]
- * NS_SUPPRESS_COMPILATION -
- *		Marks the commands in this namespace for not being compiled,
- *		forcing them to be looked up every time.
+ *		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.
+ * 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_SUPPRESS_COMPILATION	0x08
-
-/*
- * 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
- * otherValuePtr 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;
+#define NS_KILLED       0x04
 
 /*
- * 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.
+ * 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).
  */
 
-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,
-				 * ENSEMBLE_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. */
-    Tcl_Obj *parameterList;	/* List of ensemble parameter names. */
-    int numParameters;		/* Cached number of parameters. This is either
-				 * 0 (if the parameterList field is NULL) or
-				 * the length of the list in the parameterList
-				 * field. */
-} EnsembleConfig;
-
-/*
- * Various bits for the EnsembleConfig.flags field.
- */
-
-#define ENSEMBLE_DEAD	0x1	/* Flag value to say that the ensemble is dead
-				 * and on its way out. */
-#define ENSEMBLE_COMPILE 0x4	/* Flag to enable bytecode compilation of an
-				 * ensemble. */
+#define CREATE_NS_IF_UNKNOWN 0x800
 
 /*
  *----------------------------------------------------------------
- * 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 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 the 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. */
-	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. */
+	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. */
     } value;
-} Var;
-
-typedef struct VarInHash {
-    Var var;
+    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: 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;
+				 * 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 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).
- *
+ * 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. 
+ *
+ * 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_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.
- *
- * Flag values relating to the variable's trace and search status.
- *
- * VAR_TRACED_READ
- * VAR_TRACED_WRITE
- * VAR_TRACED_UNSET
- * VAR_TRACED_ARRAY
+ *				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.
- * VAR_SEARCH_ACTIVE
- *
- * The following additional flags are used with the CompiledLocal type defined
- * below:
+ *				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_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.
+ *
+ * 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.
- */
-
-/* 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)
-
-/* 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)
+#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
 
-/* 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
+#define VAR_ARGUMENT		0x100
+#define VAR_TEMPORARY		0x200
+#define VAR_RESOLVED		0x400	
 
 /*
  * Macros to ensure that various flag bits are set properly for variables.
  * The ANSI C "prototypes" for these macros are:
  *
- * 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);
+ * 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));
  */
 
 #define TclSetVarScalar(varPtr) \
-    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK)
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_ARRAY|VAR_LINK)) | VAR_SCALAR
 
 #define TclSetVarArray(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~VAR_LINK) | VAR_ARRAY
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_LINK)) | VAR_ARRAY
 
 #define TclSetVarLink(varPtr) \
-    (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_LINK
+    (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK
 
 #define TclSetVarArrayElement(varPtr) \
     (varPtr)->flags = ((varPtr)->flags & ~VAR_ARRAY) | VAR_ARRAY_ELEMENT
 
 #define TclSetVarUndefined(varPtr) \
-    (varPtr)->flags &= ~(VAR_ARRAY|VAR_LINK);\
-    (varPtr)->value.objPtr = NULL
+    (varPtr)->flags |= VAR_UNDEFINED
 
-#define TclClearVarUndefined(varPtr)
-
-#define TclSetVarTraceActive(varPtr) \
-    (varPtr)->flags |= VAR_TRACE_ACTIVE
-
-#define TclClearVarTraceActive(varPtr) \
-    (varPtr)->flags &= ~VAR_TRACE_ACTIVE
-
-#define TclSetVarNamespaceVar(varPtr) \
-    if (!TclIsVarNamespaceVar(varPtr)) {\
-	(varPtr)->flags |= VAR_NAMESPACE_VAR;\
-	((VarInHash *)(varPtr))->refCount++;\
-    }
-
-#define TclClearVarNamespaceVar(varPtr) \
-    if (TclIsVarNamespaceVar(varPtr)) {\
-	(varPtr)->flags &= ~VAR_NAMESPACE_VAR;\
-	((VarInHash *)(varPtr))->refCount--;\
-    }
+#define TclClearVarUndefined(varPtr) \
+    (varPtr)->flags &= ~VAR_UNDEFINED
 
 /*
  * Macros to read various flag bits of variables.
  * The ANSI C "prototypes" for these macros are:
  *
- * 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);
+ * 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));
  */
-
+    
 #define TclIsVarScalar(varPtr) \
-    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK))
+    ((varPtr)->flags & VAR_SCALAR)
 
 #define TclIsVarLink(varPtr) \
     ((varPtr)->flags & VAR_LINK)
@@ -834,77 +586,24 @@ typedef struct VarInHash {
     ((varPtr)->flags & VAR_ARRAY)
 
 #define TclIsVarUndefined(varPtr) \
-    ((varPtr)->value.objPtr == NULL)
+    ((varPtr)->flags & VAR_UNDEFINED)
 
 #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 TclIsVarDirectUnsettable(varPtr) \
-    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|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.
  *----------------------------------------------------------------
  */
 
@@ -917,31 +616,32 @@ 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_ARGUMENT, VAR_TEMPORARY,
-				 * and VAR_RESOLVED make sense. */
+				 * although only VAR_SCALAR, VAR_ARRAY, 
+				 * VAR_LINK, 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. */
@@ -949,326 +649,277 @@ 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[1];		/* 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 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
+ * 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 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 the traces
+				 * are scanning in reverse order. */
 } ActiveInterpTrace;
 
 /*
- * 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.
+ * 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 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. */
+    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. */
     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). */
-    TclVarHashTable *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). */
+    Tcl_HashTable *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;
-    struct NRE_callback *tailcallPtr;
-				/* NULL if no tailcall is scheduled */
 } CallFrame;
 
-#define FRAME_IS_PROC	0x1
-#define FRAME_IS_LAMBDA 0x2
-#define FRAME_IS_METHOD	0x4	/* The frame is a method body, and the frame's
-				 * clientData field contains a CallContext
-				 * reference. Part of TIP#257. */
-#define FRAME_IS_OO_DEFINE 0x8	/* The frame is part of the inside workings of
-				 * the [oo::define] command; the clientData
-				 * field contains an Object reference that has
-				 * been confirmed to refer to a class. Part of
-				 * TIP#257. */
-
+#ifdef TCL_TIP280
 /*
  * 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.
-     */
+  /* 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;
 
-    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 {
+      CONST char*  cmd;      /* The executed command, if possible */
+      int          len;      /* And its length */
+    } str;
+    Tcl_Obj*       listPtr;  /* Tcl_EvalObjEx, cmd list */
+  } cmd;
 
-    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;
-    int numLevels;		/* Value of interp's numLevels when the frame
-				 * was pushed. */
-    const struct CFWordBC *litarg;
-				/* Link to set of literal arguments which have
-				 * ben pushed on the lineLABCPtr stack by
-				 * TclArgumentBCEnter(). These will be removed
-				 * by TclArgumentBCRelease. */
 } 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 access. */
-    int word;			/* Index of the word in the command. */
-    int refCount;		/* Number of times the word is on the
-				 * stack. */
+  CmdFrame* framePtr;  /* CmdFrame to acess */
+  int       word;      /* Index of the word in the command */
+  int       refCount;  /* #times the word is on the stack */
 } CFWord;
 
 typedef struct CFWordBC {
-    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. */
-    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
-				 * CmdFrame litarg field for the list start. */
-    Tcl_Obj *obj;		/* Back reference to hashtable key */
+    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;
 } CFWordBC;
 
 /*
@@ -1281,125 +932,96 @@ typedef struct CFWordBC {
  * tracking.
  *
  * These structures are allocated and filled by both the function
- * 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.
+ * 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.
  */
 
-#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, extending behind the nominal end
-				 * of the structure. An entry containing the
-				 * value -1 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, 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. */
 } ContLineLoc;
 
-/*
- * 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. */
+#endif /* TCL_TIP280 */
 
 /*
- * 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.
+ *----------------------------------------------------------------
+ * 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 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;
+typedef VOID **TclHandle;
 
 /*
  *----------------------------------------------------------------
- * 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 related to expressions.  These are used only in
+ * tclExpr.c.
  *----------------------------------------------------------------
  */
 
-typedef void **TclHandle;
-
 /*
- *----------------------------------------------------------------
- * 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 TCL_REG_BOSONLY 002000	/* Prepend \A to pattern so it only matches at
-				 * the beginning of the string. */
+#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;
 
 /*
  * 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.
  */
 
-MODULE_SCOPE void *	TclThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
-MODULE_SCOPE void	TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
-			    void *data);
+EXTERN VOID *TclThreadDataKeyGet _ANSI_ARGS_((Tcl_ThreadDataKey *keyPtr));
+EXTERN void TclThreadDataKeySet _ANSI_ARGS_((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;
@@ -1407,108 +1029,62 @@ 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. The integer value returned by a CompileProc must
- * be one of the following:
+ * 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:
  *
  * TCL_OK		Compilation completed normally.
- * 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.
+ * 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.
  */
 
-#define TCL_OUT_LINE_COMPILE	TCL_ERROR
+#define TCL_OUT_LINE_COMPILE	(TCL_CONTINUE + 1)
 
-typedef int (CompileProc)(Tcl_Interp *interp, Tcl_Parse *parsePtr,
-	struct Command *cmdPtr, struct CompileEnv *compEnvPtr);
+typedef int (CompileProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr));
 
 /*
  * The type of procedure called from the compilation hook point in
  * SetByteCodeFromAny.
  */
 
-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;
+typedef int (CompileHookProc) _ANSI_ARGS_((Tcl_Interp *interp,
+	struct CompileEnv *compEnvPtr, ClientData clientData));
 
 /*
  * 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 member stackPtr points to the stackItems of the
- * currently active execution stack.
+ * 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.
  */
 
-typedef struct CorContext {
-    struct CallFrame *framePtr;
-    struct CallFrame *varFramePtr;
-    struct CmdFrame *cmdFramePtr;  /* See Interp.cmdFramePtr */
-    Tcl_HashTable *lineLABCPtr;    /* See Interp.lineLABCPtr */
-} CorContext;
-
-typedef struct CoroutineData {
-    struct Command *cmdPtr;	/* The command handle for the coroutine. */
-    struct ExecEnv *eePtr;	/* The special execution environment (stacks,
-				 * etc.) for the coroutine. */
-    struct ExecEnv *callerEEPtr;/* The execution environment for the caller of
-				 * the coroutine, which might be the
-				 * interpreter global environment or another
-				 * coroutine. */
-    CorContext caller;
-    CorContext running;
-    Tcl_HashTable *lineLABCPtr;    /* See Interp.lineLABCPtr */
-    void *stackLevel;
-    int auxNumLevels;		/* While the coroutine is running the
-				 * numLevels of the create/resume command is
-				 * stored here; for suspended coroutines it
-				 * holds the nesting numLevels at yield. */
-    int nargs;                  /* Number of args required for resuming this
-				 * coroutine; -2 means "0 or 1" (default), -1
-				 * means "any" */
-} CoroutineData;
-
 typedef struct ExecEnv {
-    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. */
-    struct Tcl_Interp *interp;
-    struct NRE_callback *callbackPtr;
-				/* Top callback in NRE's stack. */
-    struct CoroutineData *corPtr;
-    int rewind;
+    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;
 } ExecEnv;
 
-#define COR_IS_SUSPENDED(corPtr) \
-    ((corPtr)->stackLevel == NULL)
-
 /*
  * 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
@@ -1517,36 +1093,37 @@ 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. */
-    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. */
+    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. */
 } 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;
 
 /*
@@ -1557,53 +1134,36 @@ 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. */
-    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
-    ClientData clientData;	/* Any clientData to give the command. */
-    int unsafe;			/* Whether this command is to be hidden by
-				 * default in a safe interpreter. */
-} EnsembleImplMap;
-
-/*
  *----------------------------------------------------------------
  * Data structures related to commands.
  *----------------------------------------------------------------
@@ -1611,12 +1171,11 @@ typedef struct {
 
 /*
  * 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;
@@ -1624,11 +1183,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;
 
 /*
@@ -1641,34 +1200,35 @@ 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. */
@@ -1679,47 +1239,45 @@ 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. */
-    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of 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
 
 /*
  *----------------------------------------------------------------
@@ -1728,11 +1286,12 @@ 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 {
@@ -1741,23 +1300,18 @@ 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;
 
-/*
- * Forward declaration of the TIP#143 limit handler structure.
- */
-
-typedef struct LimitHandler LimitHandler;
-
+#ifdef TCL_TIP268
 /*
  * TIP #268.
  * Values for the selection mode, i.e the package require preferences.
@@ -1766,39 +1320,24 @@ typedef struct LimitHandler LimitHandler;
 enum PkgPreferOptions {
     PKG_PREFER_LATEST, PKG_PREFER_STABLE
 };
+#endif
 
 /*
  *----------------------------------------------------------------
- * This structure shadows the first few fields of the memory cache for the
- * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the
- * definition there.
- * Some macros require knowledge of some fields in the struct in order to
- * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
- * to the relevant fields is kept in the objCache field in struct Interp.
- *----------------------------------------------------------------
- */
-
-typedef struct AllocCache {
-    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. */
-} AllocCache;
-
-/*
- *----------------------------------------------------------------
- * 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
@@ -1807,97 +1346,106 @@ 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). */
-    const 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. */
+				 * 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. */
 
     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 unused2;	/* No longer used (was mathFuncTable) */
+				 * 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 *). */
+
+
 
     /*
-     * 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. */
+				 * procedure invocations.  NULL means there
+				 * are no active procedures. */
     CallFrame *varFramePtr;	/* Points to the call frame whose variables
 				 * are currently in use (same as framePtr
 				 * unless an "uplevel" command is
-				 * executing). */
+				 * executing). NULL means no procedure is
+				 * active or "uplevel 0" is executing. */
     ActiveVarTrace *activeVarTracePtr;
-				/* 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. */
+				/* 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 */
 
     /*
-     * 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. Ckalloc-ed. NULL means
-				 * not yet allocated. */
+    char *appendResult;		/* Storage space for results generated
+				 * by Tcl_AppendResult.	 Malloc-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. Ckalloc'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. 
+				 * Malloc'ed, may be NULL. */
+
     /*
      * Miscellaneous information:
      */
@@ -1906,42 +1454,44 @@ 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 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. */
+    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. */
     ResolverScheme *resolverPtr;
 				/* Linked list of name resolution schemes
-				 * added to this interpreter. Schemes are
-				 * added and removed by calling
+				 * added to this interpreter.  Schemes
+				 * are added/removed by calling
 				 * Tcl_AddInterpResolvers and
-				 * Tcl_RemoveInterpResolver respectively. */
+				 * Tcl_RemoveInterpResolver. */
     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
@@ -1951,137 +1501,67 @@ 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. */
-
-    /*
-     * 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
+				 * compilation */
+#ifdef TCL_TIP280
+    /* 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
@@ -2090,163 +1570,43 @@ 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.
-     */
-
-    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.
-     */
-
-    AllocCache *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 */
-    /*
-     * The pointer to the object system root ekeko. c.f. TIP #257.
-     */
-    void *objectFoundation;	/* Pointer to the Foundation structure of the
-				 * object system, which contains things like
-				 * references to key namespaces. See
-				 * tclOOInt.h and tclOO.c for real definition
-				 * and setup. */
-
-    struct NRE_callback *deferredCallbacks;
-				/* Callbacks that are set previous to a call
-				 * to some Eval function but that actually
-				 * belong to the command that is about to be
-				 * called - i.e., they should be run *before*
-				 * any tailcall is invoked. */
-
-    /*
-     * TIP #285, Script cancellation support.
+     * TIP #268.
+     * The currently active selection mode,
+     * i.e the package require preferences.
      */
 
-    Tcl_AsyncHandler asyncCancel;
-				/* Async handler token for Tcl_CancelEval. */
-    Tcl_Obj *asyncCancelMsg;	/* Error message set by async cancel handler
-				 * for the propagation of arbitrary Tcl
-				 * errors. This information, if present
-				 * (asyncCancelMsg not NULL), takes precedence
-				 * over the default error messages returned by
-				 * a script cancellation operation. */
-
-	/*
-	 * TIP #348 IMPLEMENTATION  -  Substituted error stack
-	 */
-    Tcl_Obj *errorStack;	/* [info errorstack] value (as a Tcl_Obj). */
-    Tcl_Obj *upLiteral;		/* "UP" literal for [info errorstack] */
-    Tcl_Obj *callLiteral;	/* "CALL" literal for [info errorstack] */
-    Tcl_Obj *innerLiteral;	/* "INNER" literal for [info errorstack] */
-    Tcl_Obj *innerContext;	/* cached list for fast reallocation */
-    int resetErrorStack;        /* controls cleaning up of ::errorStack */
-
-#ifdef TCL_COMPILE_STATS
+    int packagePrefer;          /* Current package selection mode. */
+#endif
     /*
      * Statistical information about the bytecode compiler and interpreter's
-     * operation. This should be the last field of Interp.
+     * operation.
      */
 
-    ByteCodeStats stats;	/* Holds compilation and execution statistics
-				 * for this interpreter. */
-#endif /* TCL_COMPILE_STATS */
+#ifdef 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)
-
-/*
- * Macros for script cancellation support (TIP #285).
- */
-
-#define TclCanceled(iPtr) \
-    (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND))
-
-#define TclSetCancelFlags(iPtr, cancelFlags)   \
-    (iPtr)->flags |= CANCELED;                 \
-    if ((cancelFlags) & TCL_CANCEL_UNWIND) {   \
-        (iPtr)->flags |= TCL_CANCEL_UNWIND;    \
-    }
-
-#define TclUnsetCancelFlags(iPtr) \
-    (iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND))
-
-/*
- * 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_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.
+ * 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_ALLOW_EXCEPTIONS	4
-#define TCL_EVAL_FILE		2
-#define TCL_EVAL_CTX		8
-#define TCL_EVAL_REDIRECT	16
+#define TCL_BRACKET_TERM	  1
+#define TCL_ALLOW_EXCEPTIONS	  4
+#ifdef TCL_TIP280
+#define TCL_EVAL_FILE             2
+#define TCL_EVAL_CTX              8
+#endif
 
 /*
  * Flag bits for Interp structures:
@@ -2255,166 +1615,116 @@ typedef struct InterpList {
  *			don't process any more commands for it, and destroy
  *			the structure as soon as all nested invocations of
  *			Tcl_Eval are done.
- * 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.
+ * 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.
  * 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.
- * CANCELED:		Non-zero means that the script in progress should be
- *			canceled as soon as possible. This can be checked by
- *			extensions (and the core itself) by calling
- *			Tcl_Canceled and checking if TCL_ERROR is returned.
- *			This is a one-shot flag that is reset immediately upon
- *			being detected; however, if the TCL_CANCEL_UNWIND flag
- *			is set Tcl_Canceled will continue to report that the
- *			script in progress has been canceled thereby allowing
- *			the evaluation stack for the interp to be fully
- *			unwound.
- *
- * 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_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
-#define CANCELED			0x1000
+#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
 
 /*
- * 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
 
 /*
- * 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.
+ * 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.
- *
- * 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.
+ * 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.
  */
 
 #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 = 0,	/* Any Unix-like OS. */
-    TCL_PLATFORM_WINDOWS = 2	/* Any Microsoft Windows OS. */
+    TCL_PLATFORM_UNIX,		/* Any Unix-like OS. */
+    TCL_PLATFORM_MAC,		/* MacOS. */
+    TCL_PLATFORM_WINDOWS	/* 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)
@@ -2422,178 +1732,62 @@ typedef enum TclEolTranslation {
 #define TCL_INVOKE_NO_TRACEBACK	(1<<2)
 
 /*
- * 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
+ * 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
  * faster.
  */
 
 typedef struct List {
-    int refCount;
     int maxElemCount;		/* Total number of element array slots. */
     int elemCount;		/* Current number of list elements. */
-    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. */
+    Tcl_Obj **elements;		/* Array of pointers to element objects. */
 } List;
 
-#define LIST_MAX \
-	(1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
-#define LIST_SIZE(numElems) \
-	(unsigned)(sizeof(List) + (((numElems) - 1) * 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.
+ * 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.
  */
 
-#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.
- */
-
-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 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 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;
-
+    
 /*
- * The "globParameters" argument of the function TclGlob is an or'ed
- * combination of the following values:
+ * Opaque names for platform specific types.
  */
 
-#define TCL_GLOBMODE_NO_COMPLAIN	1
-#define TCL_GLOBMODE_JOIN		2
-#define TCL_GLOBMODE_DIR		4
-#define TCL_GLOBMODE_TAILS		8
+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:
+ */
 
-typedef enum Tcl_PathPart {
-    TCL_PATH_DIRNAME,
-    TCL_PATH_TAIL,
-    TCL_PATH_EXTENSION,
-    TCL_PATH_ROOT
-} Tcl_PathPart;
+#define TCL_GLOBMODE_NO_COMPLAIN      1
+#define TCL_GLOBMODE_JOIN             2
+#define TCL_GLOBMODE_DIR              4
+#define TCL_GLOBMODE_TAILS            8
 
 /*
  *----------------------------------------------------------------
@@ -2601,10 +1795,12 @@ typedef enum Tcl_PathPart {
  *----------------------------------------------------------------
  */
 
-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);
+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));
+
 
 /*
  *----------------------------------------------------------------
@@ -2617,561 +1813,324 @@ 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. */
-#define TCL_PARSE_BINARY_ONLY	64
-				/* Parse binary even without prefix. */
-
-/*
- *----------------------------------------------------------------------
- * 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.
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE char *tclNativeExecutableName;
-MODULE_SCOPE int tclFindExecutableSearchDone;
-MODULE_SCOPE char *tclMemDumpFileName;
-MODULE_SCOPE TclPlatformType tclPlatform;
-MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
-
-/*
- * 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;
+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;
 
 /*
  * Variables denoting the Tcl object types defined in the core.
  */
 
-MODULE_SCOPE const Tcl_ObjType tclBignumType;
-MODULE_SCOPE const Tcl_ObjType tclBooleanType;
-MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
-MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
-MODULE_SCOPE const Tcl_ObjType tclDoubleType;
-MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
-MODULE_SCOPE const Tcl_ObjType tclIntType;
-MODULE_SCOPE const Tcl_ObjType tclListType;
-MODULE_SCOPE const Tcl_ObjType tclDictType;
-MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
-MODULE_SCOPE const Tcl_ObjType tclStringType;
-MODULE_SCOPE const Tcl_ObjType tclArraySearchType;
-MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
-#ifndef NO_WIDE_TYPE
-MODULE_SCOPE const Tcl_ObjType tclWideIntType;
-#endif
-MODULE_SCOPE const Tcl_ObjType tclRegexpType;
-MODULE_SCOPE Tcl_ObjType tclCmdNameType;
+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;
 
 /*
  * Variables denoting the hash key types defined in the core.
  */
 
-MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
-MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;
-MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType;
-MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType;
+extern Tcl_HashKeyType tclArrayHashKeyType;
+extern Tcl_HashKeyType tclOneWordHashKeyType;
+extern Tcl_HashKeyType tclStringHashKeyType;
+extern Tcl_HashKeyType tclObjHashKeyType;
 
 /*
  * The head of the list of free Tcl objects, and the total number of Tcl
  * objects ever allocated and freed.
  */
 
-MODULE_SCOPE Tcl_Obj *	tclFreeObjList;
+extern Tcl_Obj *	tclFreeObjList;
 
 #ifdef TCL_COMPILE_STATS
-MODULE_SCOPE long	tclObjsAlloced;
-MODULE_SCOPE long	tclObjsFreed;
+extern long		tclObjsAlloced;
+extern long		tclObjsFreed;
 #define TCL_MAX_SHARED_OBJ_STATS 5
-MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
+extern 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.
  */
 
-MODULE_SCOPE char *	tclEmptyStringRep;
-MODULE_SCOPE char	tclEmptyString;
+extern char *		tclEmptyStringRep;
+extern char		tclEmptyString;
 
 /*
  *----------------------------------------------------------------
- * Procedures shared among Tcl modules but not used by the outside world,
- * introduced by/for NRE.
+ * Procedures shared among Tcl modules but not used by the outside
+ * world:
  *----------------------------------------------------------------
  */
 
-MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd;
-
-MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
-
-MODULE_SCOPE void  TclSpliceTailcall(Tcl_Interp *interp,
-	               struct NRE_callback *tailcallPtr);
-
-/*
- * This structure holds the data for the various iteration callbacks used to
- * NRE the 'for' and 'while' commands. We need a separate structure because we
- * have more than the 4 client data entries we can provide directly thorugh
- * the callback API. It is the 'word' information which puts us over the
- * limit. It is needed because the loop body is argument 4 of 'for' and
- * argument 2 of 'while'. Not providing the correct index confuses the #280
- * code. We TclSmallAlloc/Free this.
- */
-
-typedef struct ForIterData {
-    Tcl_Obj *cond;		/* Loop condition expression. */
-    Tcl_Obj *body;		/* Loop body. */
-    Tcl_Obj *next;		/* Loop step script, NULL for 'while'. */
-    const char *msg;		/* Error message part. */
-    int word;			/* Index of the body script in the command */
-} ForIterData;
-
-/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
- *            and Tcl_FindSymbol. This structure corresponds to an opaque
- *            typedef in tcl.h */
-
-typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
-				const char* symbol);
-struct Tcl_LoadHandle_ {
-    ClientData clientData;	/* Client data is the load handle in the
-				 * native filesystem if a module was loaded
-				 * there, or an opaque pointer to a structure
-				 * for further bookkeeping on load-from-VFS
-				 * and load-from-memory */
-    TclFindSymbolProc* findSymbolProcPtr;
-				/* Procedure that resolves symbols in a
-				 * loaded module */
-    Tcl_FSUnloadFileProc* unloadFileProcPtr;
-				/* Procedure that unloads a loaded module */
-};
+#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));
 
-/* 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 */
+EXTERN void         TclContinuationsCopy _ANSI_ARGS_((Tcl_Obj* objPtr, Tcl_Obj* originObjPtr));
 
-/*
- *----------------------------------------------------------------
- * Procedures shared among Tcl modules but not used by the outside world:
- *----------------------------------------------------------------
- */
+#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
 
-MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
-			    const unsigned char *bytes, int len);
-MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
-			    int flags);
-MODULE_SCOPE void	TclPushTailcallPoint(Tcl_Interp *interp);
-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	TclArgumentBCEnter(Tcl_Interp *interp,
-			    Tcl_Obj *objv[], int objc,
-			    void *codePtr, CmdFrame *cfPtr, int pc);
-MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
-			    CmdFrame *cfPtr);
-MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
-			    CmdFrame **cfPtrPtr, int *wordPtr);
-MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
-			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
-MODULE_SCOPE double	TclBignumToDouble(const 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(const 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 Tcl_ObjCmdProc TclChannelNamesCmd;
-MODULE_SCOPE int	TclClearRootEnsemble(ClientData data[],
-			    Tcl_Interp *interp, int result);
-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 Tcl_ObjCmdProc TclFileAttrsCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
-MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
-MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
-			    ClientData clientData);
-MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
-			    ClientData clientData);
-MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
-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	TclFinalizeEvaluation(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(const 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 int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-			    const char *encodingName);
-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 TclGetCompletionCodeFromObj(Tcl_Interp *interp,
-			    Tcl_Obj *value, int *code);
-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 int	TclInfoCoroutineCmd(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 Tcl_Obj *	TclJoinPath(int elements, Tcl_Obj * const objv[]);
-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 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 Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
-MODULE_SCOPE int	TclNokia770Doubles(void);
-MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
-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,
-			    int *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);
-MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
-MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
-MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
-			    int len);
-MODULE_SCOPE int	TclpDeleteFile(const void *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	TclCreateSocketAddress(Tcl_Interp *interp,
-			    struct addrinfo **addrlist,
-			    const char *host, int port, int willBind,
-			    const char **errorMsgPtr);
-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 int	TclpLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-			    const char *sym1, const char *sym2,
-			    Tcl_PackageInitProc **proc1Ptr,
-			    Tcl_PackageInitProc **proc2Ptr,
-			    ClientData *clientDataPtr,
-			    Tcl_FSUnloadFileProc **unloadProcPtr);
-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_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
-			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
-			    Tcl_Obj *resultingNameObj);
-MODULE_SCOPE Tcl_Obj *	TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
-			    Tcl_PathPart portion);
-MODULE_SCOPE char *	TclpReadlink(const char *fileName,
-			    Tcl_DString *linkPtr);
-MODULE_SCOPE void	TclpSetInterfaces(void);
-MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
-MODULE_SCOPE void *	TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
-MODULE_SCOPE void	TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
-			    void *data);
-MODULE_SCOPE void	TclpThreadExit(int status);
-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	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
-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 void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
-			    int numBytes, int flags, int line,
-			    struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
-			    Tcl_Obj *const opts[], int *flagPtr);
-MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
-			    int numBytes, int flags, Tcl_Parse *parsePtr,
-			    Tcl_InterpState *statePtr);
-MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
-			    int count, int *tokensLeftPtr, int line,
-			    int *clNextOuter, const char *outerScript);
-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 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
-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);
+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));
 #endif
-MODULE_SCOPE void	TclInitThreadStorage(void);
-MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
-MODULE_SCOPE void	TclFinalizeThreadStorage(void);
-#ifdef TCL_WIDE_CLICKS
-MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
-MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
+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));
 #endif
-MODULE_SCOPE Tcl_Obj *	TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
-MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
-MODULE_SCOPE void *	TclpThreadCreateKey(void);
-MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
-MODULE_SCOPE void	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
-MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
+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	TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
+#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));
+#endif
 
 /*
  *----------------------------------------------------------------
@@ -3179,290 +2138,179 @@ MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int
  *----------------------------------------------------------------
  */
 
-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 Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
-MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
-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 int	TclChanPopObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int	TclChanPushObjCmd(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	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
-			    Var *arrayPtr, Tcl_Obj *part1Ptr,
-			    Tcl_Obj *part2Ptr, int index, int pathc,
-			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
-MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
-			    int pathc, Tcl_Obj *const pathv[]);
-MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-			    
-/* Assemble command function */			    
-MODULE_SCOPE int	Tcl_AssembleObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);			    
-MODULE_SCOPE int	TclNRAssembleObjCmd(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 Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
-MODULE_SCOPE int	TclMakeFileCommandSafe(Tcl_Interp *interp);
-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 Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
-MODULE_SCOPE int	TclNamespaceEnsembleCmd(ClientData dummy,
-			    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 Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp);
-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_RepresentationCmd(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_ThrowObjCmd(ClientData dummy, 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_TryObjCmd(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[]);
+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[]));
+
+/*
+ *----------------------------------------------------------------
+ * Command procedures found only in the Mac version of the core:
+ *----------------------------------------------------------------
+ */
+
+#ifdef MAC_TCL
+EXTERN int	Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int argc, CONST84 char **argv));
+EXTERN int	Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_MacSourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int	Tcl_ResourceObjCmd _ANSI_ARGS_((ClientData clientData,
+		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+#endif
 
 /*
  *----------------------------------------------------------------
@@ -3470,361 +2318,88 @@ MODULE_SCOPE int	Tcl_WhileObjCmd(ClientData clientData,
  *----------------------------------------------------------------
  */
 
-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	TclCompileDictWithCmd(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	TclCompileErrorCmd(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	TclCompileLrangeCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, Command *cmdPtr,
-			    struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclCompileLreplaceCmd(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	TclCompileNamespaceUpvarCmd(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	TclCompileSubstCmd(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	TclCompileThrowCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, Command *cmdPtr,
-			    struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclCompileTryCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, Command *cmdPtr,
-			    struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclCompileUnsetCmd(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);
-			    
-MODULE_SCOPE int	TclCompileAssembleCmd(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 int	TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr,
-			    Var *arrayPtr, Tcl_Obj *part1Ptr,
-			    Tcl_Obj *part2Ptr, const int flags,
-			    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);
-
-MODULE_SCOPE int	TclFullFinalizationRequested(void);
+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));
 
 /*
  *----------------------------------------------------------------
  * 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:
  *
- * MODULE_SCOPE void	TclNewObj(Tcl_Obj *objPtr);
- * MODULE_SCOPE void	TclDecrRefCount(Tcl_Obj *objPtr);
+ * EXTERN void	TclNewObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+ * EXTERN void	TclDecrRefCount _ANSI_ARGS_((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.
  *----------------------------------------------------------------
  */
 
@@ -3833,10 +2408,7 @@ MODULE_SCOPE int	TclFullFinalizationRequested(void);
  */
 
 #ifdef USE_DTRACE
-#ifndef _TCLDTRACE_H
-typedef const char *TclDTraceStr;
 #include "tclDTrace.h"
-#endif
 #define	TCL_DTRACE_OBJ_CREATE(objPtr)	TCL_OBJ_CREATE(objPtr)
 #define	TCL_DTRACE_OBJ_FREE(objPtr)	TCL_OBJ_FREE(objPtr)
 #else /* USE_DTRACE */
@@ -3854,116 +2426,94 @@ typedef const char *TclDTraceStr;
 #  define TclIncrObjsFreed()
 #endif /* TCL_COMPILE_STATS */
 
-#  define TclAllocObjStorage(objPtr)		\
-	TclAllocObjStorageEx(NULL, (objPtr))
-
-#  define TclFreeObjStorage(objPtr)		\
-	TclFreeObjStorageEx(NULL, (objPtr))
-
-#ifndef TCL_MEM_DEBUG
-# define TclNewObj(objPtr) \
-    TclIncrObjsAllocated(); \
+#define TclNewObj(objPtr) \
     TclAllocObjStorage(objPtr); \
+    TclIncrObjsAllocated(); \
     (objPtr)->refCount = 0; \
     (objPtr)->bytes    = tclEmptyStringRep; \
     (objPtr)->length   = 0; \
     (objPtr)->typePtr  = NULL; \
     TCL_DTRACE_OBJ_CREATE(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'.
- * 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); \
+#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); \
 	} \
+        TclFreeObjStorage(objPtr); \
+	TclIncrObjsFreed(); \
     }
+#endif
 
-#if defined(PURIFY)
+#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)
 
 /*
  * 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 TclAllocObjStorageEx(interp, objPtr) \
-	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))
+#  define TclAllocObjStorage(objPtr) \
+       (objPtr) = (Tcl_Obj *) Tcl_Ckalloc(sizeof(Tcl_Obj))
 
-#  define TclFreeObjStorageEx(interp, objPtr) \
-	ckfree((char *) (objPtr))
+#  define TclFreeObjStorage(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.
  */
 
-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 *);
+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 *));
 
-/*
- * These macros need to be kept in sync with the code of TclThreadAllocObj()
- * and TclThreadFreeObj().
- *
- * Note that the optimiser should resolve the case (interp==NULL) at compile
- * time.
- */
 
-#  define ALLOC_NOBJHIGH 1200
-
-#  define TclAllocObjStorageEx(interp, objPtr)				\
-    do {								\
-	AllocCache *cachePtr;						\
-	if (((interp) == NULL) ||					\
-		((cachePtr = ((Interp *)(interp))->allocCache),		\
-			(cachePtr->numObjects == 0))) {			\
-	    (objPtr) = TclThreadAllocObj();				\
-	} else {							\
-	    (objPtr) = cachePtr->firstObjPtr;				\
-	    cachePtr->firstObjPtr = (objPtr)->internalRep.otherValuePtr; \
-	    --cachePtr->numObjects;					\
-	}								\
-    } while (0)
-
-#  define TclFreeObjStorageEx(interp, objPtr)				\
-    do {								\
-	AllocCache *cachePtr;						\
-	if (((interp) == NULL) ||					\
-		((cachePtr = ((Interp *)(interp))->allocCache),		\
-			(cachePtr->numObjects >= ALLOC_NOBJHIGH))) {	\
-	    TclThreadFreeObj(objPtr);					\
-	} else {							\
-	    (objPtr)->internalRep.otherValuePtr = cachePtr->firstObjPtr; \
-	    cachePtr->firstObjPtr = objPtr;				\
-	    ++cachePtr->numObjects;					\
-	}								\
-    } while (0)
-
-#else /* not PURIFY or USE_THREAD_ALLOC */
+#  define TclAllocObjStorage(objPtr) \
+       (objPtr) = TclThreadAllocObj()
+
+#  define TclFreeObjStorage(objPtr) \
+       TclThreadFreeObj((objPtr))
+
+#else /* not TCL_MEM_DEBUG */
 
 #if defined(USE_TCLALLOC) && USE_TCLALLOC
     MODULE_SCOPE void TclFinalizeAllocSubsystem();
@@ -3974,67 +2524,38 @@ MODULE_SCOPE void	TclpFreeAllocCache(void *);
 
 #ifdef TCL_THREADS
 /* declared in tclObj.c */
-MODULE_SCOPE Tcl_Mutex	tclObjMutex;
+extern Tcl_Mutex tclObjMutex;
 #endif
 
-#  define TclAllocObjStorageEx(interp, objPtr) \
-    do {								\
-	Tcl_MutexLock(&tclObjMutex);					\
-	if (tclFreeObjList == NULL) {					\
-	    TclAllocateFreeObjects();					\
-	}								\
-	(objPtr) = tclFreeObjList;					\
-	tclFreeObjList = (Tcl_Obj *)					\
-		tclFreeObjList->internalRep.otherValuePtr;		\
-	Tcl_MutexUnlock(&tclObjMutex);					\
-    } while (0)
-
-#  define TclFreeObjStorageEx(interp, objPtr) \
-    do {							       \
-	Tcl_MutexLock(&tclObjMutex);				       \
-	(objPtr)->internalRep.otherValuePtr = (void *) tclFreeObjList; \
-	tclFreeObjList = (objPtr);				       \
-	Tcl_MutexUnlock(&tclObjMutex);				       \
-    } while (0)
-#endif
-
-#else /* TCL_MEM_DEBUG */
-MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
-			    int line);
-
-# define TclDbNewObj(objPtr, file, line) \
-    do { \
-	TclIncrObjsAllocated();						\
-	(objPtr) = (Tcl_Obj *)						\
-		Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line));		\
-	TclDbInitNewObj((objPtr), (file), (line));			\
-	TCL_DTRACE_OBJ_CREATE(objPtr);					\
-    } while (0)
-
-# define TclNewObj(objPtr) \
-    TclDbNewObj(objPtr, __FILE__, __LINE__);
-
-# define TclDecrRefCount(objPtr) \
-    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+#  define TclAllocObjStorage(objPtr) \
+       Tcl_MutexLock(&tclObjMutex); \
+       if (tclFreeObjList == NULL) { \
+	   TclAllocateFreeObjects(); \
+       } \
+       (objPtr) = tclFreeObjList; \
+       tclFreeObjList = (Tcl_Obj *) \
+	   tclFreeObjList->internalRep.otherValuePtr; \
+       Tcl_MutexUnlock(&tclObjMutex)
+
+#  define TclFreeObjStorage(objPtr) \
+       Tcl_MutexLock(&tclObjMutex); \
+       (objPtr)->internalRep.otherValuePtr = (VOID *) tclFreeObjList; \
+       tclFreeObjList = (objPtr); \
+       Tcl_MutexUnlock(&tclObjMutex)
 
-# 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:
- *
- * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len);
+ * 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:
  *
- * This macro should only be called on an unshared objPtr where
- *  objPtr->typePtr->freeIntRepProc == NULL
+ * EXTERN void	TclInitStringRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+ *		    char *bytePtr, int len));
  *----------------------------------------------------------------
  */
 
@@ -4044,667 +2565,88 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 	(objPtr)->length = 0; \
     } else { \
 	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
-	memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
+	memcpy((VOID *) (objPtr)->bytes, (VOID *) (bytePtr), \
+		(unsigned) (len)); \
 	(objPtr)->bytes[len] = '\0'; \
 	(objPtr)->length = (len); \
     }
 
 /*
  *----------------------------------------------------------------
- * 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:
  *
- * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
+ * EXTERN char *  TclGetString _ANSI_ARGS_((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 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);
- *----------------------------------------------------------------
- */
-
-#define TclFreeIntRep(objPtr) \
-    if ((objPtr)->typePtr != NULL) { \
-	if ((objPtr)->typePtr->freeIntRepProc != NULL) { \
-	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
-	} \
-	(objPtr)->typePtr = NULL; \
-    }
-
-/*
- *----------------------------------------------------------------
- * Macro used by the Tcl core to clean out an object's string representation.
- * The ANSI C "prototype" for this macro is:
- *
- * 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);
+ * 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.
  *----------------------------------------------------------------
  */
 
-/* General tuning for minimum growth in Tcl growth algorithms */
-#ifndef TCL_MIN_GROWTH
-#  ifdef TCL_GROWTH_MIN_ALLOC
-     /* Support for any legacy tuners */
-#    define TCL_MIN_GROWTH TCL_GROWTH_MIN_ALLOC
-#  else
-#    define TCL_MIN_GROWTH 1024
-#  endif
-#endif
-
-/* Token growth tuning, default to the general value. */
-#ifndef TCL_MIN_TOKEN_GROWTH
-#define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token)
+#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 TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
-#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr)	\
-    do {								\
-	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(newPtr, staticPtr,				\
-			(size_t) ((used) * sizeof(Tcl_Token)));		\
-	    }								\
-	    (tokenPtr) = newPtr;					\
-	}								\
-    } while (0)
-
-#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:
+ * 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);
+ * EXTERN int TclUtfToUniChar _ANSI_ARGS_((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 counterpart of the Tcl_NumUtfChars() function. To be used in speed-
- * -sensitive points where it pays to avoid a function call in the common case
- * of counting along a string of all one-byte characters.  The ANSI C
- * "prototype" for this macro is:
- *
- * MODULE_SCOPE void	TclNumUtfChars(int numChars, const char *bytes,
- *				int numBytes);
- *----------------------------------------------------------------
- */
-
-#define TclNumUtfChars(numChars, bytes, numBytes) \
-    do { \
-	int count, i = (numBytes); \
-	unsigned char *str = (unsigned char *) (bytes); \
-	while (i && (*str < 0xC0)) { i--; str++; } \
-	count = (numBytes) - i; \
-	if (i) { \
-	    count += Tcl_NumUtfChars((bytes) + count, i); \
-	} \
-	(numChars) = count; \
-    } while (0);
-
-/*
- *----------------------------------------------------------------
- * Macro that encapsulates the logic that determines when it is safe to
- * interpret a string as a byte array directly. In summary, the object must be
- * a byte array and must not have a string representation (as the operations
- * that it is used in are defined on strings, not byte arrays). Theoretically
- * it is possible to also be efficient in the case where the object's bytes
- * field is filled by generation from the byte array (c.f. list canonicality)
- * but we don't do that at the moment since this is purely about efficiency.
+ * 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:
  *
- * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
+ * EXTERN int TclUniCharNcmp _ANSI_ARGS_((CONST Tcl_UniChar *cs,
+ *         CONST Tcl_UniChar *ct, unsigned long n));
  *----------------------------------------------------------------
  */
-
-#define TclIsPureByteArray(objPtr) \
-	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
-
-/*
- *----------------------------------------------------------------
- * 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:
- *
- * 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 */
 
-/*
- *----------------------------------------------------------------
- * 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 Tcl_PackageInitProc TclTommath_Init;
-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);
-
-/*
- *----------------------------------------------------------------------
- *
- * External (platform specific) initialization routine, these declarations
- * explicitly don't use EXTERN since this code does not get compiled into the
- * library:
- *
- *----------------------------------------------------------------------
- */
-
-MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit;
-MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init;
-MODULE_SCOPE Tcl_PackageInitProc TclThread_Init;
-MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init;
-MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
-
-/*
- *----------------------------------------------------------------
- * 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) \
-    do {						\
-	TclInvalidateStringRep(objPtr);			\
-	TclFreeIntRep(objPtr);				\
-	(objPtr)->internalRep.longValue = (long)(i);	\
-	(objPtr)->typePtr = &tclIntType;		\
-    } while (0)
-
-#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) \
-    do {							\
-	TclInvalidateStringRep(objPtr);				\
-	TclFreeIntRep(objPtr);					\
-	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
-	(objPtr)->typePtr = &tclWideIntType;			\
-    } while (0)
-#endif
-
-#define TclSetDoubleObj(objPtr, d) \
-    do {							\
-	TclInvalidateStringRep(objPtr);				\
-	TclFreeIntRep(objPtr);					\
-	(objPtr)->internalRep.doubleValue = (double)(d);	\
-	(objPtr)->typePtr = &tclDoubleType;			\
-    } while (0)
-
-/*
- *----------------------------------------------------------------
- * 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) \
-    do {						\
-	TclIncrObjsAllocated();				\
-	TclAllocObjStorage(objPtr);			\
-	(objPtr)->refCount = 0;				\
-	(objPtr)->bytes = NULL;				\
-	(objPtr)->internalRep.longValue = (long)(i);	\
-	(objPtr)->typePtr = &tclIntType;		\
-	TCL_DTRACE_OBJ_CREATE(objPtr);			\
-    } while (0)
-
-#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) \
-    do {							\
-	TclIncrObjsAllocated();					\
-	TclAllocObjStorage(objPtr);				\
-	(objPtr)->refCount = 0;					\
-	(objPtr)->bytes = NULL;					\
-	(objPtr)->internalRep.doubleValue = (double)(d);	\
-	(objPtr)->typePtr = &tclDoubleType;			\
-	TCL_DTRACE_OBJ_CREATE(objPtr);				\
-    } while (0)
-
-#define TclNewStringObj(objPtr, s, len) \
-    do {							\
-	TclIncrObjsAllocated();					\
-	TclAllocObjStorage(objPtr);				\
-	(objPtr)->refCount = 0;					\
-	TclInitStringRep((objPtr), (s), (len));			\
-	(objPtr)->typePtr = NULL;				\
-	TCL_DTRACE_OBJ_CREATE(objPtr);				\
-    } while (0)
-
-#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);
- */
-
-#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)))
-
-/*
- * Compile-time assertions: these produce a compile time error if the
- * expression is not known to be true at compile time. If the assertion is
- * known to be false, the compiler (or optimizer?) will error out with
- * "division by zero". If the assertion cannot be evaluated at compile time,
- * the compiler will error out with "non-static initializer".
- *
- * Adapted with permission from
- * http://www.pixelbeat.org/programming/gcc/static_assert.html
- */
-
-#define TCL_CT_ASSERT(e) \
-    {enum { ct_assert_value = 1/(!!(e)) };}
-
-/*
- *----------------------------------------------------------------
- * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool.
- * Only checked at compile time.
- *
- * ONLY USE FOR CONSTANT nBytes.
- *
- * DO NOT LET THEM CROSS THREAD BOUNDARIES
- *----------------------------------------------------------------
- */
-
-#define TclSmallAlloc(nbytes, memPtr) \
-    TclSmallAllocEx(NULL, (nbytes), (memPtr))
-
-#define TclSmallFree(memPtr) \
-    TclSmallFreeEx(NULL, (memPtr))
-
-#ifndef TCL_MEM_DEBUG
-#define TclSmallAllocEx(interp, nbytes, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr;						\
-	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
-	TclIncrObjsAllocated();						\
-	TclAllocObjStorageEx((interp), (objPtr));			\
-	memPtr = (ClientData) (objPtr);					\
-    } while (0)
-
-#define TclSmallFreeEx(interp, memPtr) \
-    do {								\
-	TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));		\
-	TclIncrObjsFreed();						\
-    } while (0)
-
-#else    /* TCL_MEM_DEBUG */
-#define TclSmallAllocEx(interp, nbytes, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr;						\
-	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
-	TclNewObj(objPtr);						\
-	memPtr = (ClientData) objPtr;					\
-    } while (0)
-
-#define TclSmallFreeEx(interp, memPtr) \
-    do {								\
-	Tcl_Obj *objPtr = (Tcl_Obj *) memPtr;				\
-	objPtr->bytes = NULL;						\
-	objPtr->typePtr = NULL;						\
-	objPtr->refCount = 1;						\
-	TclDecrRefCount(objPtr);					\
-    } while (0)
-#endif   /* TCL_MEM_DEBUG */
-
-/*
- * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
- */
-
-#if defined(PURIFY) && defined(__clang__)
-#if __has_feature(attribute_analyzer_noreturn) && \
-	!defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED)
-void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
-#endif
-#if !defined(CLANG_ASSERT)
-#include <assert.h>
-#define CLANG_ASSERT(x) assert(x)
-#endif
-#elif !defined(CLANG_ASSERT)
-#define CLANG_ASSERT(x)
-#endif /* PURIFY && __clang__ */
-
-/*
- *----------------------------------------------------------------
- * Parameters, structs and macros for the non-recursive engine (NRE)
- *----------------------------------------------------------------
- */
-
-#define NRE_USE_SMALL_ALLOC	1  /* Only turn off for debugging purposes. */
-#define NRE_ENABLE_ASSERTS	1
-
-/*
- * This is the main data struct for representing NR commands. It is designed
- * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator
- * available.
- */
-
-typedef struct NRE_callback {
-    Tcl_NRPostProc *procPtr;
-    ClientData data[4];
-    struct NRE_callback *nextPtr;
-} NRE_callback;
-
-#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)
-
-/*
- * Inline version of Tcl_NRAddCallback.
- */
-
-#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
-    do {								\
-	NRE_callback *callbackPtr;					\
-	TCLNR_ALLOC((interp), (callbackPtr));				\
-	callbackPtr->procPtr = (postProcPtr);				\
-	callbackPtr->data[0] = (ClientData)(data0);			\
-	callbackPtr->data[1] = (ClientData)(data1);			\
-	callbackPtr->data[2] = (ClientData)(data2);			\
-	callbackPtr->data[3] = (ClientData)(data3);			\
-	callbackPtr->nextPtr = TOP_CB(interp);				\
-	TOP_CB(interp) = callbackPtr;					\
-    } while (0)
-
-#define TclNRDeferCallback(interp,postProcPtr,data0,data1,data2,data3) \
-    do {								\
-	NRE_callback *callbackPtr;					\
-	TCLNR_ALLOC((interp), (callbackPtr));				\
-	callbackPtr->procPtr = (postProcPtr);				\
-	callbackPtr->data[0] = (ClientData)(data0);			\
-	callbackPtr->data[1] = (ClientData)(data1);			\
-	callbackPtr->data[2] = (ClientData)(data2);			\
-	callbackPtr->data[3] = (ClientData)(data3);			\
-	callbackPtr->nextPtr = ((Interp *)interp)->deferredCallbacks;	\
-	((Interp *)interp)->deferredCallbacks = callbackPtr;		\
-    } while (0)
-
-#define TclNRSpliceCallbacks(interp, topPtr) \
-    do {					\
-	NRE_callback *bottomPtr = topPtr;	\
-	while (bottomPtr->nextPtr) {		\
-	    bottomPtr = bottomPtr->nextPtr;	\
-	}					\
-	bottomPtr->nextPtr = TOP_CB(interp);	\
-	TOP_CB(interp) = topPtr;		\
-    } while (0)
-
-#define TclNRSpliceDeferred(interp)					\
-    if (((Interp *)interp)->deferredCallbacks) {			\
-	TclNRSpliceCallbacks(interp, ((Interp *)interp)->deferredCallbacks); \
-	((Interp *)interp)->deferredCallbacks = NULL;			\
-    }
-
-#if NRE_USE_SMALL_ALLOC
-#define TCLNR_ALLOC(interp, ptr) \
-    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
-#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
-#else
-#define TCLNR_ALLOC(interp, ptr) \
-    (ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
-#define TCLNR_FREE(interp, ptr)  ckfree((char *) (ptr))
-#endif
-
-#if NRE_ENABLE_ASSERTS
-#define NRE_ASSERT(expr) assert((expr))
-#else
-#define NRE_ASSERT(expr)
-#endif
-
 #include "tclIntDecls.h"
-#include "tclIntPlatDecls.h"
-#include "tclTomMathDecls.h"
 
-#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
-#define Tcl_AttemptAlloc(size)        TclpAlloc(size)
-#define Tcl_AttemptRealloc(ptr, size) TclpRealloc((ptr), (size))
-#define Tcl_Free(ptr)                 TclpFree(ptr)
-#endif
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
 
 #endif /* _TCLINT */
 
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index d01d10a..94860aa 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -15,34 +15,6 @@
 #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_AppendExportList
-#undef Tcl_CreateNamespace
-#undef Tcl_DeleteNamespace
-#undef Tcl_Export
-#undef Tcl_FindCommand
-#undef Tcl_FindNamespace
-#undef Tcl_FindNamespaceVar
-#undef Tcl_ForgetImport
-#undef Tcl_GetCommandFromObj
-#undef Tcl_GetCommandFullName
-#undef Tcl_GetCurrentNamespace
-#undef Tcl_GetGlobalNamespace
-#undef Tcl_Import
-
 /*
  * WARNING: This file is automatically generated by the tools/genStubs.tcl
  * script.  Any modifications to the function declarations below should be made
@@ -56,169 +28,222 @@
  */
 
 /* Slot 0 is reserved */
-/* Slot 1 is reserved */
-/* Slot 2 is reserved */
+/* 1 */
+EXTERN int		TclAccessDeleteProc _ANSI_ARGS_((
+				TclAccessProc_ *proc));
+/* 2 */
+EXTERN int		TclAccessInsertProc _ANSI_ARGS_((
+				TclAccessProc_ *proc));
 /* 3 */
-EXTERN void		TclAllocateFreeObjects(void);
+EXTERN void		TclAllocateFreeObjects _ANSI_ARGS_((void));
 /* Slot 4 is reserved */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 5 */
+EXTERN int		TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
+				int numPids, Tcl_Pid *pidPtr,
+				Tcl_Channel errorChan));
+#endif /* UNIX */
+#ifdef __WIN32__
 /* 5 */
-EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
-				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
+EXTERN int		TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
+				int numPids, Tcl_Pid *pidPtr,
+				Tcl_Channel errorChan));
+#endif /* __WIN32__ */
 /* 6 */
-EXTERN void		TclCleanupCommand(Command *cmdPtr);
+EXTERN void		TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
 /* 7 */
-EXTERN int		TclCopyAndCollapse(int count, const char *src,
-				char *dst);
+EXTERN int		TclCopyAndCollapse _ANSI_ARGS_((int count,
+				CONST char *src, char *dst));
 /* 8 */
-EXTERN int		TclCopyChannelOld(Tcl_Interp *interp,
+EXTERN int		TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp,
 				Tcl_Channel inChan, Tcl_Channel outChan,
-				int toRead, Tcl_Obj *cmdPtr);
+				int toRead, Tcl_Obj *cmdPtr));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 9 */
+EXTERN int		TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
+				int argc, CONST char **argv,
+				Tcl_Pid **pidArrayPtr, TclFile *inPipePtr,
+				TclFile *outPipePtr, TclFile *errFilePtr));
+#endif /* UNIX */
+#ifdef __WIN32__
 /* 9 */
-EXTERN int		TclCreatePipeline(Tcl_Interp *interp, int argc,
-				const char **argv, Tcl_Pid **pidArrayPtr,
-				TclFile *inPipePtr, TclFile *outPipePtr,
-				TclFile *errFilePtr);
+EXTERN int		TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
+				int argc, CONST char **argv,
+				Tcl_Pid **pidArrayPtr, TclFile *inPipePtr,
+				TclFile *outPipePtr, TclFile *errFilePtr));
+#endif /* __WIN32__ */
 /* 10 */
-EXTERN int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
-				const char *procName, Tcl_Obj *argsPtr,
-				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
+EXTERN int		TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
+				Namespace *nsPtr, CONST char *procName,
+				Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
+				Proc **procPtrPtr));
 /* 11 */
-EXTERN void		TclDeleteCompiledLocalVars(Interp *iPtr,
-				CallFrame *framePtr);
+EXTERN void		TclDeleteCompiledLocalVars _ANSI_ARGS_((Interp *iPtr,
+				CallFrame *framePtr));
 /* 12 */
-EXTERN void		TclDeleteVars(Interp *iPtr,
-				TclVarHashTable *tablePtr);
-/* Slot 13 is reserved */
+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));
 /* 14 */
-EXTERN int		TclDumpMemoryInfo(ClientData clientData, int flags);
+EXTERN void		TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
 /* Slot 15 is reserved */
 /* 16 */
-EXTERN void		TclExprFloatError(Tcl_Interp *interp, double value);
+EXTERN void		TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
+				double value));
 /* Slot 17 is reserved */
 /* Slot 18 is reserved */
 /* Slot 19 is reserved */
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
 /* 22 */
-EXTERN int		TclFindElement(Tcl_Interp *interp,
-				const char *listStr, int listLength,
-				const char **elementPtr,
-				const char **nextPtr, int *sizePtr,
-				int *bracePtr);
+EXTERN int		TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *listStr, int listLength,
+				CONST char **elementPtr,
+				CONST char **nextPtr, int *sizePtr,
+				int *bracePtr));
 /* 23 */
-EXTERN Proc *		TclFindProc(Interp *iPtr, const char *procName);
+EXTERN Proc *		TclFindProc _ANSI_ARGS_((Interp *iPtr,
+				CONST char *procName));
 /* 24 */
-EXTERN int		TclFormatInt(char *buffer, long n);
+EXTERN int		TclFormatInt _ANSI_ARGS_((char *buffer, long n));
 /* 25 */
-EXTERN void		TclFreePackageInfo(Interp *iPtr);
+EXTERN void		TclFreePackageInfo _ANSI_ARGS_((Interp *iPtr));
 /* Slot 26 is reserved */
-/* Slot 27 is reserved */
+/* 27 */
+EXTERN int		TclGetDate _ANSI_ARGS_((char *p, Tcl_WideInt now,
+				long zone, Tcl_WideInt *timePtr));
 /* 28 */
-EXTERN Tcl_Channel	TclpGetDefaultStdChannel(int type);
+EXTERN Tcl_Channel	TclpGetDefaultStdChannel _ANSI_ARGS_((int type));
 /* Slot 29 is reserved */
 /* Slot 30 is reserved */
 /* 31 */
-EXTERN const char *	TclGetExtension(const char *name);
+EXTERN char *		TclGetExtension _ANSI_ARGS_((char *name));
 /* 32 */
-EXTERN int		TclGetFrame(Tcl_Interp *interp, const char *str,
-				CallFrame **framePtrPtr);
-/* Slot 33 is reserved */
+EXTERN int		TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *str, CallFrame **framePtrPtr));
+/* 33 */
+EXTERN TclCmdProcType	TclGetInterpProc _ANSI_ARGS_((void));
 /* 34 */
-EXTERN int		TclGetIntForIndex(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int endValue, int *indexPtr);
+EXTERN int		TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, int endValue, int *indexPtr));
 /* Slot 35 is reserved */
-/* Slot 36 is reserved */
+/* 36 */
+EXTERN int		TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *str, long *longPtr));
 /* 37 */
-EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
-				const char *targetName);
+EXTERN int		TclGetLoadedPackages _ANSI_ARGS_((Tcl_Interp *interp,
+				char *targetName));
 /* 38 */
-EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
-				const char *qualName, Namespace *cxtNsPtr,
-				int flags, Namespace **nsPtrPtr,
+EXTERN int		TclGetNamespaceForQualName _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *qualName,
+				Namespace *cxtNsPtr, int flags,
+				Namespace **nsPtrPtr,
 				Namespace **altNsPtrPtr,
 				Namespace **actualCxtPtrPtr,
-				const char **simpleNamePtr);
+				CONST char **simpleNamePtr));
 /* 39 */
-EXTERN TclObjCmdProcType TclGetObjInterpProc(void);
+EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
 /* 40 */
-EXTERN int		TclGetOpenMode(Tcl_Interp *interp, const char *str,
-				int *seekFlagPtr);
+EXTERN int		TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *str, int *seekFlagPtr));
 /* 41 */
-EXTERN Tcl_Command	TclGetOriginalCommand(Tcl_Command command);
+EXTERN Tcl_Command	TclGetOriginalCommand _ANSI_ARGS_((
+				Tcl_Command command));
 /* 42 */
-EXTERN CONST86 char *	TclpGetUserHome(const char *name,
-				Tcl_DString *bufferPtr);
-/* Slot 43 is reserved */
+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));
 /* 44 */
-EXTERN int		TclGuessPackageName(const char *fileName,
-				Tcl_DString *bufPtr);
+EXTERN int		TclGuessPackageName _ANSI_ARGS_((
+				CONST char *fileName, Tcl_DString *bufPtr));
 /* 45 */
-EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
+EXTERN int		TclHideUnsafeCommands _ANSI_ARGS_((
+				Tcl_Interp *interp));
 /* 46 */
-EXTERN int		TclInExit(void);
+EXTERN int		TclInExit _ANSI_ARGS_((void));
 /* Slot 47 is reserved */
 /* Slot 48 is reserved */
-/* Slot 49 is reserved */
+/* 49 */
+EXTERN Tcl_Obj *	TclIncrVar2 _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
+				long incrAmount, int part1NotParsed));
 /* 50 */
-EXTERN void		TclInitCompiledLocals(Tcl_Interp *interp,
-				CallFrame *framePtr, Namespace *nsPtr);
+EXTERN void		TclInitCompiledLocals _ANSI_ARGS_((
+				Tcl_Interp *interp, CallFrame *framePtr,
+				Namespace *nsPtr));
 /* 51 */
-EXTERN int		TclInterpInit(Tcl_Interp *interp);
-/* Slot 52 is reserved */
+EXTERN int		TclInterpInit _ANSI_ARGS_((Tcl_Interp *interp));
+/* 52 */
+EXTERN int		TclInvoke _ANSI_ARGS_((Tcl_Interp *interp, int argc,
+				CONST84 char **argv, int flags));
 /* 53 */
-EXTERN int		TclInvokeObjectCommand(ClientData clientData,
-				Tcl_Interp *interp, int argc,
-				CONST84 char **argv);
+EXTERN int		TclInvokeObjectCommand _ANSI_ARGS_((
+				ClientData clientData, Tcl_Interp *interp,
+				int argc, CONST84 char **argv));
 /* 54 */
-EXTERN int		TclInvokeStringCommand(ClientData clientData,
-				Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[]);
+EXTERN int		TclInvokeStringCommand _ANSI_ARGS_((
+				ClientData clientData, Tcl_Interp *interp,
+				int objc, Tcl_Obj *CONST objv[]));
 /* 55 */
-EXTERN Proc *		TclIsProc(Command *cmdPtr);
+EXTERN Proc *		TclIsProc _ANSI_ARGS_((Command *cmdPtr));
 /* Slot 56 is reserved */
 /* Slot 57 is reserved */
 /* 58 */
-EXTERN Var *		TclLookupVar(Tcl_Interp *interp, const char *part1,
-				const char *part2, int flags,
-				const char *msg, int createPart1,
-				int createPart2, Var **arrayPtrPtr);
+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));
 /* Slot 59 is reserved */
 /* 60 */
-EXTERN int		TclNeedSpace(const char *start, const char *end);
+EXTERN int		TclNeedSpace _ANSI_ARGS_((CONST char *start,
+				CONST char *end));
 /* 61 */
-EXTERN Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
+EXTERN Tcl_Obj *	TclNewProcBodyObj _ANSI_ARGS_((Proc *procPtr));
 /* 62 */
-EXTERN int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
+EXTERN int		TclObjCommandComplete _ANSI_ARGS_((Tcl_Obj *cmdPtr));
 /* 63 */
-EXTERN int		TclObjInterpProc(ClientData clientData,
+EXTERN int		TclObjInterpProc _ANSI_ARGS_((ClientData clientData,
 				Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[]);
+				Tcl_Obj *CONST objv[]));
 /* 64 */
-EXTERN int		TclObjInvoke(Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[], int flags);
-/* Slot 65 is reserved */
-/* Slot 66 is reserved */
-/* Slot 67 is reserved */
+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));
 /* Slot 68 is reserved */
 /* 69 */
-EXTERN char *		TclpAlloc(unsigned int size);
+EXTERN char *		TclpAlloc _ANSI_ARGS_((unsigned int size));
 /* Slot 70 is reserved */
 /* Slot 71 is reserved */
 /* Slot 72 is reserved */
 /* Slot 73 is reserved */
 /* 74 */
-EXTERN void		TclpFree(char *ptr);
+EXTERN void		TclpFree _ANSI_ARGS_((char *ptr));
 /* 75 */
-EXTERN unsigned long	TclpGetClicks(void);
+EXTERN unsigned long	TclpGetClicks _ANSI_ARGS_((void));
 /* 76 */
-EXTERN unsigned long	TclpGetSeconds(void);
+EXTERN unsigned long	TclpGetSeconds _ANSI_ARGS_((void));
 /* 77 */
-EXTERN void		TclpGetTime(Tcl_Time *time);
-/* Slot 78 is reserved */
+EXTERN void		TclpGetTime _ANSI_ARGS_((Tcl_Time *time));
+/* 78 */
+EXTERN int		TclpGetTimeZone _ANSI_ARGS_((Tcl_WideInt time));
 /* Slot 79 is reserved */
 /* Slot 80 is reserved */
 /* 81 */
-EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
+EXTERN char *		TclpRealloc _ANSI_ARGS_((char *ptr,
+				unsigned int size));
 /* Slot 82 is reserved */
 /* Slot 83 is reserved */
 /* Slot 84 is reserved */
@@ -226,235 +251,274 @@ EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
 /* Slot 86 is reserved */
 /* Slot 87 is reserved */
 /* 88 */
-EXTERN char *		TclPrecTraceProc(ClientData clientData,
-				Tcl_Interp *interp, const char *name1,
-				const char *name2, int flags);
+EXTERN char *		TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
+				Tcl_Interp *interp, CONST char *name1,
+				CONST char *name2, int flags));
 /* 89 */
-EXTERN int		TclPreventAliasLoop(Tcl_Interp *interp,
-				Tcl_Interp *cmdInterp, Tcl_Command cmd);
+EXTERN int		TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Interp *cmdInterp, Tcl_Command cmd));
 /* Slot 90 is reserved */
 /* 91 */
-EXTERN void		TclProcCleanupProc(Proc *procPtr);
+EXTERN void		TclProcCleanupProc _ANSI_ARGS_((Proc *procPtr));
 /* 92 */
-EXTERN int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
-				Tcl_Obj *bodyPtr, Namespace *nsPtr,
-				const char *description,
-				const char *procName);
+EXTERN int		TclProcCompileProc _ANSI_ARGS_((Tcl_Interp *interp,
+				Proc *procPtr, Tcl_Obj *bodyPtr,
+				Namespace *nsPtr, CONST char *description,
+				CONST char *procName));
 /* 93 */
-EXTERN void		TclProcDeleteProc(ClientData clientData);
-/* Slot 94 is reserved */
+EXTERN void		TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
+/* 94 */
+EXTERN int		TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
+				Tcl_Interp *interp, int argc,
+				CONST84 char **argv));
 /* Slot 95 is reserved */
 /* 96 */
-EXTERN int		TclRenameCommand(Tcl_Interp *interp,
-				const char *oldName, const char *newName);
+EXTERN int		TclRenameCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				char *oldName, char *newName));
 /* 97 */
-EXTERN void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
-				Command *newCmdPtr);
+EXTERN void		TclResetShadowedCmdRefs _ANSI_ARGS_((
+				Tcl_Interp *interp, Command *newCmdPtr));
 /* 98 */
-EXTERN int		TclServiceIdle(void);
+EXTERN int		TclServiceIdle _ANSI_ARGS_((void));
 /* Slot 99 is reserved */
 /* Slot 100 is reserved */
 /* 101 */
-EXTERN CONST86 char *	TclSetPreInitScript(const char *string);
+EXTERN char *		TclSetPreInitScript _ANSI_ARGS_((char *string));
 /* 102 */
-EXTERN void		TclSetupEnv(Tcl_Interp *interp);
+EXTERN void		TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
 /* 103 */
-EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
-				const char *proto, int *portPtr);
+EXTERN int		TclSockGetPort _ANSI_ARGS_((Tcl_Interp *interp,
+				char *str, char *proto, int *portPtr));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 104 */
-EXTERN int		TclSockMinimumBuffersOld(int sock, int size);
+EXTERN int		TclSockMinimumBuffersOld _ANSI_ARGS_((int sock,
+				int size));
+#endif /* UNIX */
+#ifdef __WIN32__
+/* 104 */
+EXTERN int		TclSockMinimumBuffersOld _ANSI_ARGS_((int sock,
+				int size));
+#endif /* __WIN32__ */
 /* Slot 105 is reserved */
-/* Slot 106 is reserved */
-/* Slot 107 is reserved */
+/* 106 */
+EXTERN int		TclStatDeleteProc _ANSI_ARGS_((TclStatProc_ *proc));
+/* 107 */
+EXTERN int		TclStatInsertProc _ANSI_ARGS_((TclStatProc_ *proc));
 /* 108 */
-EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
+EXTERN void		TclTeardownNamespace _ANSI_ARGS_((Namespace *nsPtr));
 /* 109 */
-EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
+EXTERN int		TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+/* 110 */
+EXTERN int		TclSockMinimumBuffers _ANSI_ARGS_((VOID *sock,
+				int size));
+#endif /* UNIX */
+#ifdef __WIN32__
 /* 110 */
-EXTERN int		TclSockMinimumBuffers(void *sock, int size);
+EXTERN int		TclSockMinimumBuffers _ANSI_ARGS_((VOID *sock,
+				int size));
+#endif /* __WIN32__ */
 /* 111 */
-EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
-				const char *name,
+EXTERN void		Tcl_AddInterpResolvers _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *name,
 				Tcl_ResolveCmdProc *cmdProc,
 				Tcl_ResolveVarProc *varProc,
-				Tcl_ResolveCompiledVarProc *compiledVarProc);
+				Tcl_ResolveCompiledVarProc *compiledVarProc));
 /* 112 */
-EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
+EXTERN int		Tcl_AppendExportList _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr));
 /* 113 */
-EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
-				const char *name, ClientData clientData,
-				Tcl_NamespaceDeleteProc *deleteProc);
+EXTERN Tcl_Namespace *	Tcl_CreateNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name, ClientData clientData,
+				Tcl_NamespaceDeleteProc *deleteProc));
 /* 114 */
-EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
+EXTERN void		Tcl_DeleteNamespace _ANSI_ARGS_((
+				Tcl_Namespace *nsPtr));
 /* 115 */
-EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				const char *pattern, int resetListFirst);
+EXTERN int		Tcl_Export _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, CONST char *pattern,
+				int resetListFirst));
 /* 116 */
-EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, const char *name,
-				Tcl_Namespace *contextNsPtr, int flags);
+EXTERN Tcl_Command	Tcl_FindCommand _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name,
+				Tcl_Namespace *contextNsPtr, int flags));
 /* 117 */
-EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
-				const char *name,
-				Tcl_Namespace *contextNsPtr, int flags);
+EXTERN Tcl_Namespace *	Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name,
+				Tcl_Namespace *contextNsPtr, int flags));
 /* 118 */
-EXTERN int		Tcl_GetInterpResolvers(Tcl_Interp *interp,
-				const char *name, Tcl_ResolverInfo *resInfo);
+EXTERN int		Tcl_GetInterpResolvers _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *name,
+				Tcl_ResolverInfo *resInfo));
 /* 119 */
-EXTERN int		Tcl_GetNamespaceResolvers(
+EXTERN int		Tcl_GetNamespaceResolvers _ANSI_ARGS_((
 				Tcl_Namespace *namespacePtr,
-				Tcl_ResolverInfo *resInfo);
+				Tcl_ResolverInfo *resInfo));
 /* 120 */
-EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
-				const char *name,
-				Tcl_Namespace *contextNsPtr, int flags);
+EXTERN Tcl_Var		Tcl_FindNamespaceVar _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *name,
+				Tcl_Namespace *contextNsPtr, int flags));
 /* 121 */
-EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
-				Tcl_Namespace *nsPtr, const char *pattern);
+EXTERN int		Tcl_ForgetImport _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, CONST char *pattern));
 /* 122 */
-EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr);
+EXTERN Tcl_Command	Tcl_GetCommandFromObj _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *objPtr));
 /* 123 */
-EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
-				Tcl_Command command, Tcl_Obj *objPtr);
+EXTERN void		Tcl_GetCommandFullName _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Command command,
+				Tcl_Obj *objPtr));
 /* 124 */
-EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
+EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace _ANSI_ARGS_((
+				Tcl_Interp *interp));
 /* 125 */
-EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
+EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace _ANSI_ARGS_((
+				Tcl_Interp *interp));
 /* 126 */
-EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
-				Tcl_Var variable, Tcl_Obj *objPtr);
+EXTERN void		Tcl_GetVariableFullName _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Var variable,
+				Tcl_Obj *objPtr));
 /* 127 */
-EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
-				const char *pattern, int allowOverwrite);
+EXTERN int		Tcl_Import _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Namespace *nsPtr, CONST char *pattern,
+				int allowOverwrite));
 /* 128 */
-EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
+EXTERN void		Tcl_PopCallFrame _ANSI_ARGS_((Tcl_Interp *interp));
 /* 129 */
-EXTERN int		Tcl_PushCallFrame(Tcl_Interp *interp,
+EXTERN int		Tcl_PushCallFrame _ANSI_ARGS_((Tcl_Interp *interp,
 				Tcl_CallFrame *framePtr,
-				Tcl_Namespace *nsPtr, int isProcCallFrame);
+				Tcl_Namespace *nsPtr, int isProcCallFrame));
 /* 130 */
-EXTERN int		Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
-				const char *name);
+EXTERN int		Tcl_RemoveInterpResolvers _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *name));
 /* 131 */
-EXTERN void		Tcl_SetNamespaceResolvers(
+EXTERN void		Tcl_SetNamespaceResolvers _ANSI_ARGS_((
 				Tcl_Namespace *namespacePtr,
 				Tcl_ResolveCmdProc *cmdProc,
 				Tcl_ResolveVarProc *varProc,
-				Tcl_ResolveCompiledVarProc *compiledVarProc);
+				Tcl_ResolveCompiledVarProc *compiledVarProc));
 /* 132 */
-EXTERN int		TclpHasSockets(Tcl_Interp *interp);
+EXTERN int		TclpHasSockets _ANSI_ARGS_((Tcl_Interp *interp));
 /* 133 */
-EXTERN struct tm *	TclpGetDate(const time_t *time, int useGMT);
-/* Slot 134 is reserved */
-/* Slot 135 is reserved */
+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));
 /* Slot 136 is reserved */
 /* Slot 137 is reserved */
 /* 138 */
-EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
-				Tcl_DString *valuePtr);
+EXTERN CONST84_RETURN char * TclGetEnv _ANSI_ARGS_((CONST char *name,
+				Tcl_DString *valuePtr));
 /* Slot 139 is reserved */
-/* Slot 140 is reserved */
+/* 140 */
+EXTERN int		TclLooksLikeInt _ANSI_ARGS_((CONST char *bytes,
+				int length));
 /* 141 */
-EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
-				Tcl_DString *cwdPtr);
+EXTERN CONST84_RETURN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_DString *cwdPtr));
 /* 142 */
-EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, CompileHookProc *hookProc,
-				ClientData clientData);
+EXTERN int		TclSetByteCodeFromAny _ANSI_ARGS_((
+				Tcl_Interp *interp, Tcl_Obj *objPtr,
+				CompileHookProc *hookProc,
+				ClientData clientData));
 /* 143 */
-EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
-				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
+EXTERN int		TclAddLiteralObj _ANSI_ARGS_((
+				struct CompileEnv *envPtr, Tcl_Obj *objPtr,
+				LiteralEntry **litPtrPtr));
 /* 144 */
-EXTERN void		TclHideLiteral(Tcl_Interp *interp,
-				struct CompileEnv *envPtr, int index);
+EXTERN void		TclHideLiteral _ANSI_ARGS_((Tcl_Interp *interp,
+				struct CompileEnv *envPtr, int index));
 /* 145 */
-EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
+EXTERN struct AuxDataType * TclGetAuxDataType _ANSI_ARGS_((char *typeName));
 /* 146 */
-EXTERN TclHandle	TclHandleCreate(void *ptr);
+EXTERN TclHandle	TclHandleCreate _ANSI_ARGS_((VOID *ptr));
 /* 147 */
-EXTERN void		TclHandleFree(TclHandle handle);
+EXTERN void		TclHandleFree _ANSI_ARGS_((TclHandle handle));
 /* 148 */
-EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
+EXTERN TclHandle	TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
 /* 149 */
-EXTERN void		TclHandleRelease(TclHandle handle);
+EXTERN void		TclHandleRelease _ANSI_ARGS_((TclHandle handle));
 /* 150 */
-EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
+EXTERN int		TclRegAbout _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_RegExp re));
 /* 151 */
-EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, int index,
-				int *startPtr, int *endPtr);
+EXTERN void		TclRegExpRangeUniChar _ANSI_ARGS_((Tcl_RegExp re,
+				int index, int *startPtr, int *endPtr));
 /* 152 */
-EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
+EXTERN void		TclSetLibraryPath _ANSI_ARGS_((Tcl_Obj *pathPtr));
 /* 153 */
-EXTERN Tcl_Obj *	TclGetLibraryPath(void);
+EXTERN Tcl_Obj *	TclGetLibraryPath _ANSI_ARGS_((void));
 /* Slot 154 is reserved */
 /* Slot 155 is reserved */
 /* 156 */
-EXTERN void		TclRegError(Tcl_Interp *interp, const char *msg,
-				int status);
+EXTERN void		TclRegError _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *msg, int status));
 /* 157 */
-EXTERN Var *		TclVarTraceExists(Tcl_Interp *interp,
-				const char *varName);
-/* Slot 158 is reserved */
-/* Slot 159 is reserved */
+EXTERN Var *		TclVarTraceExists _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *varName));
+/* 158 */
+EXTERN void		TclSetStartupScriptFileName _ANSI_ARGS_((
+				CONST char *filename));
+/* 159 */
+EXTERN CONST84_RETURN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
 /* Slot 160 is reserved */
 /* 161 */
-EXTERN int		TclChannelTransform(Tcl_Interp *interp,
-				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
+EXTERN int		TclChannelTransform _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan, Tcl_Obj *cmdObjPtr));
 /* 162 */
-EXTERN void		TclChannelEventScriptInvoker(ClientData clientData,
-				int flags);
+EXTERN void		TclChannelEventScriptInvoker _ANSI_ARGS_((
+				ClientData clientData, int flags));
 /* 163 */
-EXTERN const void *	TclGetInstructionTable(void);
+EXTERN VOID *		TclGetInstructionTable _ANSI_ARGS_((void));
 /* 164 */
-EXTERN void		TclExpandCodeArray(void *envPtr);
+EXTERN void		TclExpandCodeArray _ANSI_ARGS_((VOID *envPtr));
 /* 165 */
-EXTERN void		TclpSetInitialEncodings(void);
+EXTERN void		TclpSetInitialEncodings _ANSI_ARGS_((void));
 /* 166 */
-EXTERN int		TclListObjSetElement(Tcl_Interp *interp,
+EXTERN int		TclListObjSetElement _ANSI_ARGS_((Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int index,
-				Tcl_Obj *valuePtr);
-/* Slot 167 is reserved */
-/* Slot 168 is reserved */
+				Tcl_Obj *valuePtr));
+/* 167 */
+EXTERN void		TclSetStartupScriptPath _ANSI_ARGS_((
+				Tcl_Obj *pathPtr));
+/* 168 */
+EXTERN Tcl_Obj *	TclGetStartupScriptPath _ANSI_ARGS_((void));
 /* 169 */
-EXTERN int		TclpUtfNcmp2(const char *s1, const char *s2,
-				unsigned long n);
+EXTERN int		TclpUtfNcmp2 _ANSI_ARGS_((CONST char *s1,
+				CONST char *s2, unsigned long n));
 /* 170 */
-EXTERN int		TclCheckInterpTraces(Tcl_Interp *interp,
-				const char *command, int numChars,
+EXTERN int		TclCheckInterpTraces _ANSI_ARGS_((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[]));
 /* 171 */
-EXTERN int		TclCheckExecutionTraces(Tcl_Interp *interp,
-				const char *command, int numChars,
-				Command *cmdPtr, int result, int traceFlags,
-				int objc, Tcl_Obj *const objv[]);
+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[]));
 /* 172 */
-EXTERN int		TclInThreadExit(void);
+EXTERN int		TclInThreadExit _ANSI_ARGS_((void));
 /* 173 */
-EXTERN int		TclUniCharMatch(const Tcl_UniChar *string,
-				int strLen, const Tcl_UniChar *pattern,
-				int ptnLen, int flags);
+EXTERN int		TclUniCharMatch _ANSI_ARGS_((
+				CONST Tcl_UniChar *string, int strLen,
+				CONST Tcl_UniChar *pattern, int ptnLen,
+				int nocase));
 /* Slot 174 is reserved */
-/* 175 */
-EXTERN int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
-				Var *varPtr, const char *part1,
-				const char *part2, int flags,
-				int leaveErrMsg);
-/* 176 */
-EXTERN void		TclCleanupVar(Var *varPtr, Var *arrayPtr);
-/* 177 */
-EXTERN void		TclVarErrMsg(Tcl_Interp *interp, const char *part1,
-				const char *part2, const char *operation,
-				const char *reason);
+/* Slot 175 is reserved */
+/* Slot 176 is reserved */
+/* Slot 177 is reserved */
 /* Slot 178 is reserved */
 /* Slot 179 is reserved */
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
 /* 182 */
-EXTERN struct tm *	TclpLocaltime(const time_t *clock);
+EXTERN struct tm *	TclpLocaltime _ANSI_ARGS_((TclpTime_t_CONST clock));
 /* 183 */
-EXTERN struct tm *	TclpGmtime(const time_t *clock);
+EXTERN struct tm *	TclpGmtime _ANSI_ARGS_((TclpTime_t_CONST clock));
 /* Slot 184 is reserved */
 /* Slot 185 is reserved */
 /* Slot 186 is reserved */
@@ -469,709 +533,883 @@ EXTERN struct tm *	TclpGmtime(const time_t *clock);
 /* Slot 195 is reserved */
 /* Slot 196 is reserved */
 /* Slot 197 is reserved */
-/* 198 */
-EXTERN int		TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				CallFrame **framePtrPtr);
-/* Slot 199 is reserved */
-/* 200 */
-EXTERN int		TclpObjRemoveDirectory(Tcl_Obj *pathPtr,
-				int recursive, Tcl_Obj **errorPtr);
-/* 201 */
-EXTERN int		TclpObjCopyDirectory(Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
-/* 202 */
-EXTERN int		TclpObjCreateDirectory(Tcl_Obj *pathPtr);
-/* 203 */
-EXTERN int		TclpObjDeleteFile(Tcl_Obj *pathPtr);
-/* 204 */
-EXTERN int		TclpObjCopyFile(Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr);
-/* 205 */
-EXTERN int		TclpObjRenameFile(Tcl_Obj *srcPathPtr,
-				Tcl_Obj *destPathPtr);
-/* 206 */
-EXTERN int		TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
-/* 207 */
-EXTERN int		TclpObjAccess(Tcl_Obj *pathPtr, int mode);
-/* 208 */
-EXTERN Tcl_Channel	TclpOpenFileChannel(Tcl_Interp *interp,
-				Tcl_Obj *pathPtr, int mode, int permissions);
-/* Slot 209 is reserved */
-/* Slot 210 is reserved */
-/* Slot 211 is reserved */
-/* 212 */
-EXTERN void		TclpFindExecutable(const char *argv0);
-/* 213 */
-EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
-/* 214 */
-EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
-				Tcl_Encoding encoding);
-/* 215 */
-EXTERN void *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
-/* 216 */
-EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
-/* 217 */
-EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
-				Tcl_CallFrame **framePtrPtr,
-				Tcl_Namespace *namespacePtr,
-				int isProcCallFrame);
-/* 218 */
-EXTERN void		TclPopStackFrame(Tcl_Interp *interp);
-/* Slot 219 is reserved */
-/* Slot 220 is reserved */
-/* Slot 221 is reserved */
-/* Slot 222 is reserved */
-/* Slot 223 is reserved */
-/* 224 */
-EXTERN TclPlatformType * TclGetPlatform(void);
-/* 225 */
-EXTERN Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
-				Tcl_Obj *rootPtr, int keyc,
-				Tcl_Obj *const keyv[], int flags);
-/* 226 */
-EXTERN int		TclObjBeingDeleted(Tcl_Obj *objPtr);
-/* 227 */
-EXTERN void		TclSetNsPath(Namespace *nsPtr, int pathLength,
-				Tcl_Namespace *pathAry[]);
-/* Slot 228 is reserved */
-/* 229 */
-EXTERN int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
-				const char *myName, int myFlags, int index);
-/* 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);
-/* 231 */
-EXTERN int		TclGetNamespaceFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
-/* 232 */
-EXTERN int		TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags, const CmdFrame *invoker, int word);
-/* 233 */
-EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
-/* 234 */
-EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
-				const char *key, int *newPtr);
-/* 235 */
-EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
-				Namespace *nsPtr);
-/* Slot 236 is reserved */
-/* 237 */
-EXTERN int		TclResetCancellation(Tcl_Interp *interp, int force);
-/* 238 */
-EXTERN int		TclNRInterpProc(ClientData clientData,
-				Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[]);
-/* 239 */
-EXTERN int		TclNRInterpProcCore(Tcl_Interp *interp,
-				Tcl_Obj *procNameObj, int skip,
-				ProcErrorProc *errorProc);
-/* 240 */
-EXTERN int		TclNRRunCallbacks(Tcl_Interp *interp, int result,
-				struct NRE_callback *rootPtr);
-/* 241 */
-EXTERN int		TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
-				int flags, const CmdFrame *invoker, int word);
-/* 242 */
-EXTERN int		TclNREvalObjv(Tcl_Interp *interp, int objc,
-				Tcl_Obj *const objv[], int flags,
-				Command *cmdPtr);
-/* 243 */
-EXTERN void		TclDbDumpActiveObjects(FILE *outFile);
-/* 244 */
-EXTERN Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
-/* 245 */
-EXTERN Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
-/* 246 */
-EXTERN int		TclInitRewriteEnsemble(Tcl_Interp *interp,
-				int numRemoved, int numInserted,
-				Tcl_Obj *const *objv);
-/* 247 */
-EXTERN void		TclResetRewriteEnsemble(Tcl_Interp *interp,
-				int isRootEnsemble);
-/* 248 */
-EXTERN int		TclCopyChannel(Tcl_Interp *interp,
-				Tcl_Channel inChan, Tcl_Channel outChan,
-				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
-/* 249 */
-EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
-				int *decpt, int *signum, char **endPtr);
-/* 250 */
-EXTERN void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
-				int force);
+/* Slot 198 is reserved */
+/* 199 */
+EXTERN int		TclMatchIsTrivial _ANSI_ARGS_((CONST char *pattern));
 
 typedef struct TclIntStubs {
     int magic;
-    const struct TclIntStubHooks *hooks;
+    struct TclIntStubHooks *hooks;
 
-    void (*reserved0)(void);
-    void (*reserved1)(void);
-    void (*reserved2)(void);
-    void (*tclAllocateFreeObjects) (void); /* 3 */
-    void (*reserved4)(void);
-    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 (*tclCopyChannelOld) (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)(void);
-    int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
-    void (*reserved15)(void);
-    void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
-    void (*reserved17)(void);
-    void (*reserved18)(void);
-    void (*reserved19)(void);
-    void (*reserved20)(void);
-    void (*reserved21)(void);
-    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)(void);
-    void (*reserved27)(void);
-    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
-    void (*reserved29)(void);
-    void (*reserved30)(void);
-    const char * (*tclGetExtension) (const char *name); /* 31 */
-    int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
-    void (*reserved33)(void);
-    int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */
-    void (*reserved35)(void);
-    void (*reserved36)(void);
-    int (*tclGetLoadedPackages) (Tcl_Interp *interp, const 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 */
-    CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
-    void (*reserved43)(void);
-    int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
-    int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
-    int (*tclInExit) (void); /* 46 */
-    void (*reserved47)(void);
-    void (*reserved48)(void);
-    void (*reserved49)(void);
-    void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
-    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
-    void (*reserved52)(void);
-    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);
-    void (*reserved57)(void);
-    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)(void);
-    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);
-    void (*reserved66)(void);
-    void (*reserved67)(void);
-    void (*reserved68)(void);
-    char * (*tclpAlloc) (unsigned int size); /* 69 */
-    void (*reserved70)(void);
-    void (*reserved71)(void);
-    void (*reserved72)(void);
-    void (*reserved73)(void);
-    void (*tclpFree) (char *ptr); /* 74 */
-    unsigned long (*tclpGetClicks) (void); /* 75 */
-    unsigned long (*tclpGetSeconds) (void); /* 76 */
-    void (*tclpGetTime) (Tcl_Time *time); /* 77 */
-    void (*reserved78)(void);
-    void (*reserved79)(void);
-    void (*reserved80)(void);
-    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
-    void (*reserved82)(void);
-    void (*reserved83)(void);
-    void (*reserved84)(void);
-    void (*reserved85)(void);
-    void (*reserved86)(void);
-    void (*reserved87)(void);
-    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);
-    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);
-    void (*reserved95)(void);
-    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);
-    void (*reserved100)(void);
-    CONST86 char * (*tclSetPreInitScript) (const 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)(void);
-    void (*reserved106)(void);
-    void (*reserved107)(void);
-    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);
-    void (*reserved135)(void);
-    void (*reserved136)(void);
-    void (*reserved137)(void);
-    CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
-    void (*reserved139)(void);
-    void (*reserved140)(void);
-    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 */
-    const struct AuxDataType * (*tclGetAuxDataType) (const 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);
-    void (*reserved155)(void);
-    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
-    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
-    void (*reserved158)(void);
-    void (*reserved159)(void);
-    void (*reserved160)(void);
-    int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
-    void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
-    const 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 (*reserved167)(void);
-    void (*reserved168)(void);
-    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);
-    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 (*reserved178)(void);
-    void (*reserved179)(void);
-    void (*reserved180)(void);
-    void (*reserved181)(void);
-    struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
-    struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
-    void (*reserved184)(void);
-    void (*reserved185)(void);
-    void (*reserved186)(void);
-    void (*reserved187)(void);
-    void (*reserved188)(void);
-    void (*reserved189)(void);
-    void (*reserved190)(void);
-    void (*reserved191)(void);
-    void (*reserved192)(void);
-    void (*reserved193)(void);
-    void (*reserved194)(void);
-    void (*reserved195)(void);
-    void (*reserved196)(void);
-    void (*reserved197)(void);
-    int (*tclObjGetFrame) (Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* 198 */
-    void (*reserved199)(void);
-    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);
-    void (*reserved210)(void);
-    void (*reserved211)(void);
-    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);
-    void (*reserved220)(void);
-    void (*reserved221)(void);
-    void (*reserved222)(void);
-    void (*reserved223)(void);
-    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 */
-    void (*reserved228)(void);
-    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 (*reserved236)(void);
-    int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
-    int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
-    int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
-    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
-    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
-    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
-    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
-    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
-    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
-    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
-    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
-    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
-    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
-    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
+    VOID *reserved0;
+    int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ *proc)); /* 1 */
+    int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ *proc)); /* 2 */
+    void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */
+    VOID *reserved4;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan)); /* 5 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan)); /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved5;
+#endif /* MAC_TCL */
+    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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr)); /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr)); /* 9 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved9;
+#endif /* MAC_TCL */
+    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 */
+    VOID *reserved15;
+    void (*tclExprFloatError) _ANSI_ARGS_((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 */
+    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 *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 */
+    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 */
+    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 *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 */
+    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 */
+    VOID *reserved68;
+    char * (*tclpAlloc) _ANSI_ARGS_((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 *reserved79;
+    VOID *reserved80;
+    char * (*tclpRealloc) _ANSI_ARGS_((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 */
+    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 *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 */
+    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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    int (*tclSockMinimumBuffersOld) _ANSI_ARGS_((int sock, int size)); /* 104 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    int (*tclSockMinimumBuffersOld) _ANSI_ARGS_((int sock, int size)); /* 104 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved104;
+#endif /* MAC_TCL */
+    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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    int (*tclSockMinimumBuffers) _ANSI_ARGS_((VOID *sock, int size)); /* 110 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    int (*tclSockMinimumBuffers) _ANSI_ARGS_((VOID *sock, int size)); /* 110 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID *reserved110;
+#endif /* MAC_TCL */
+    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 *reserved136;
+    VOID *reserved137;
+    CONST84_RETURN char * (*tclGetEnv) _ANSI_ARGS_((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 *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 *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 */
+    VOID *reserved174;
+    VOID *reserved175;
+    VOID *reserved176;
+    VOID *reserved177;
+    VOID *reserved178;
+    VOID *reserved179;
+    VOID *reserved180;
+    VOID *reserved181;
+    struct tm * (*tclpLocaltime) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 182 */
+    struct tm * (*tclpGmtime) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 183 */
+    VOID *reserved184;
+    VOID *reserved185;
+    VOID *reserved186;
+    VOID *reserved187;
+    VOID *reserved188;
+    VOID *reserved189;
+    VOID *reserved190;
+    VOID *reserved191;
+    VOID *reserved192;
+    VOID *reserved193;
+    VOID *reserved194;
+    VOID *reserved195;
+    VOID *reserved196;
+    VOID *reserved197;
+    VOID *reserved198;
+    int (*tclMatchIsTrivial) _ANSI_ARGS_((CONST char *pattern)); /* 199 */
 } TclIntStubs;
 
 #ifdef __cplusplus
 extern "C" {
 #endif
-extern const TclIntStubs *tclIntStubsPtr;
+extern TclIntStubs *tclIntStubsPtr;
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS)
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
 
 /*
  * Inline function declarations:
  */
 
 /* Slot 0 is reserved */
-/* Slot 1 is reserved */
-/* Slot 2 is reserved */
+#ifndef TclAccessDeleteProc
+#define TclAccessDeleteProc \
+	(tclIntStubsPtr->tclAccessDeleteProc) /* 1 */
+#endif
+#ifndef TclAccessInsertProc
+#define TclAccessInsertProc \
+	(tclIntStubsPtr->tclAccessInsertProc) /* 2 */
+#endif
+#ifndef TclAllocateFreeObjects
 #define TclAllocateFreeObjects \
 	(tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
+#endif
 /* Slot 4 is reserved */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclCleanupChildren
+#define TclCleanupChildren \
+	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclCleanupChildren
 #define TclCleanupChildren \
 	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
+#endif
+#endif /* __WIN32__ */
+#ifndef TclCleanupCommand
 #define TclCleanupCommand \
 	(tclIntStubsPtr->tclCleanupCommand) /* 6 */
+#endif
+#ifndef TclCopyAndCollapse
 #define TclCopyAndCollapse \
 	(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
-#define TclCopyChannelOld \
-	(tclIntStubsPtr->tclCopyChannelOld) /* 8 */
+#endif
+#ifndef TclCopyChannel
+#define TclCopyChannel \
+	(tclIntStubsPtr->tclCopyChannel) /* 8 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclCreatePipeline
 #define TclCreatePipeline \
 	(tclIntStubsPtr->tclCreatePipeline) /* 9 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclCreatePipeline
+#define TclCreatePipeline \
+	(tclIntStubsPtr->tclCreatePipeline) /* 9 */
+#endif
+#endif /* __WIN32__ */
+#ifndef TclCreateProc
 #define TclCreateProc \
 	(tclIntStubsPtr->tclCreateProc) /* 10 */
+#endif
+#ifndef TclDeleteCompiledLocalVars
 #define TclDeleteCompiledLocalVars \
 	(tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
+#endif
+#ifndef TclDeleteVars
 #define TclDeleteVars \
 	(tclIntStubsPtr->tclDeleteVars) /* 12 */
-/* Slot 13 is reserved */
+#endif
+#ifndef TclDoGlob
+#define TclDoGlob \
+	(tclIntStubsPtr->tclDoGlob) /* 13 */
+#endif
+#ifndef TclDumpMemoryInfo
 #define TclDumpMemoryInfo \
 	(tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
+#endif
 /* Slot 15 is reserved */
+#ifndef TclExprFloatError
 #define TclExprFloatError \
 	(tclIntStubsPtr->tclExprFloatError) /* 16 */
+#endif
 /* Slot 17 is reserved */
 /* Slot 18 is reserved */
 /* Slot 19 is reserved */
 /* Slot 20 is reserved */
 /* Slot 21 is reserved */
+#ifndef TclFindElement
 #define TclFindElement \
 	(tclIntStubsPtr->tclFindElement) /* 22 */
+#endif
+#ifndef TclFindProc
 #define TclFindProc \
 	(tclIntStubsPtr->tclFindProc) /* 23 */
+#endif
+#ifndef TclFormatInt
 #define TclFormatInt \
 	(tclIntStubsPtr->tclFormatInt) /* 24 */
+#endif
+#ifndef TclFreePackageInfo
 #define TclFreePackageInfo \
 	(tclIntStubsPtr->tclFreePackageInfo) /* 25 */
+#endif
 /* Slot 26 is reserved */
-/* Slot 27 is reserved */
+#ifndef TclGetDate
+#define TclGetDate \
+	(tclIntStubsPtr->tclGetDate) /* 27 */
+#endif
+#ifndef TclpGetDefaultStdChannel
 #define TclpGetDefaultStdChannel \
 	(tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */
+#endif
 /* Slot 29 is reserved */
 /* Slot 30 is reserved */
+#ifndef TclGetExtension
 #define TclGetExtension \
 	(tclIntStubsPtr->tclGetExtension) /* 31 */
+#endif
+#ifndef TclGetFrame
 #define TclGetFrame \
 	(tclIntStubsPtr->tclGetFrame) /* 32 */
-/* Slot 33 is reserved */
+#endif
+#ifndef TclGetInterpProc
+#define TclGetInterpProc \
+	(tclIntStubsPtr->tclGetInterpProc) /* 33 */
+#endif
+#ifndef TclGetIntForIndex
 #define TclGetIntForIndex \
 	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
+#endif
 /* Slot 35 is reserved */
-/* Slot 36 is reserved */
+#ifndef TclGetLong
+#define TclGetLong \
+	(tclIntStubsPtr->tclGetLong) /* 36 */
+#endif
+#ifndef TclGetLoadedPackages
 #define TclGetLoadedPackages \
 	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
+#endif
+#ifndef TclGetNamespaceForQualName
 #define TclGetNamespaceForQualName \
 	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
+#endif
+#ifndef TclGetObjInterpProc
 #define TclGetObjInterpProc \
 	(tclIntStubsPtr->tclGetObjInterpProc) /* 39 */
+#endif
+#ifndef TclGetOpenMode
 #define TclGetOpenMode \
 	(tclIntStubsPtr->tclGetOpenMode) /* 40 */
+#endif
+#ifndef TclGetOriginalCommand
 #define TclGetOriginalCommand \
 	(tclIntStubsPtr->tclGetOriginalCommand) /* 41 */
+#endif
+#ifndef TclpGetUserHome
 #define TclpGetUserHome \
 	(tclIntStubsPtr->tclpGetUserHome) /* 42 */
-/* Slot 43 is reserved */
+#endif
+#ifndef TclGlobalInvoke
+#define TclGlobalInvoke \
+	(tclIntStubsPtr->tclGlobalInvoke) /* 43 */
+#endif
+#ifndef TclGuessPackageName
 #define TclGuessPackageName \
 	(tclIntStubsPtr->tclGuessPackageName) /* 44 */
+#endif
+#ifndef TclHideUnsafeCommands
 #define TclHideUnsafeCommands \
 	(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
+#endif
+#ifndef TclInExit
 #define TclInExit \
 	(tclIntStubsPtr->tclInExit) /* 46 */
+#endif
 /* Slot 47 is reserved */
 /* Slot 48 is reserved */
-/* Slot 49 is reserved */
+#ifndef TclIncrVar2
+#define TclIncrVar2 \
+	(tclIntStubsPtr->tclIncrVar2) /* 49 */
+#endif
+#ifndef TclInitCompiledLocals
 #define TclInitCompiledLocals \
 	(tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
+#endif
+#ifndef TclInterpInit
 #define TclInterpInit \
 	(tclIntStubsPtr->tclInterpInit) /* 51 */
-/* Slot 52 is reserved */
+#endif
+#ifndef TclInvoke
+#define TclInvoke \
+	(tclIntStubsPtr->tclInvoke) /* 52 */
+#endif
+#ifndef TclInvokeObjectCommand
 #define TclInvokeObjectCommand \
 	(tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
+#endif
+#ifndef TclInvokeStringCommand
 #define TclInvokeStringCommand \
 	(tclIntStubsPtr->tclInvokeStringCommand) /* 54 */
+#endif
+#ifndef TclIsProc
 #define TclIsProc \
 	(tclIntStubsPtr->tclIsProc) /* 55 */
+#endif
 /* Slot 56 is reserved */
 /* Slot 57 is reserved */
+#ifndef TclLookupVar
 #define TclLookupVar \
 	(tclIntStubsPtr->tclLookupVar) /* 58 */
+#endif
 /* Slot 59 is reserved */
+#ifndef TclNeedSpace
 #define TclNeedSpace \
 	(tclIntStubsPtr->tclNeedSpace) /* 60 */
+#endif
+#ifndef TclNewProcBodyObj
 #define TclNewProcBodyObj \
 	(tclIntStubsPtr->tclNewProcBodyObj) /* 61 */
+#endif
+#ifndef TclObjCommandComplete
 #define TclObjCommandComplete \
 	(tclIntStubsPtr->tclObjCommandComplete) /* 62 */
+#endif
+#ifndef TclObjInterpProc
 #define TclObjInterpProc \
 	(tclIntStubsPtr->tclObjInterpProc) /* 63 */
+#endif
+#ifndef TclObjInvoke
 #define TclObjInvoke \
 	(tclIntStubsPtr->tclObjInvoke) /* 64 */
-/* Slot 65 is reserved */
-/* Slot 66 is reserved */
-/* Slot 67 is reserved */
+#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 68 is reserved */
+#ifndef TclpAlloc
 #define TclpAlloc \
 	(tclIntStubsPtr->tclpAlloc) /* 69 */
+#endif
 /* Slot 70 is reserved */
 /* Slot 71 is reserved */
 /* Slot 72 is reserved */
 /* Slot 73 is reserved */
+#ifndef TclpFree
 #define TclpFree \
 	(tclIntStubsPtr->tclpFree) /* 74 */
+#endif
+#ifndef TclpGetClicks
 #define TclpGetClicks \
 	(tclIntStubsPtr->tclpGetClicks) /* 75 */
+#endif
+#ifndef TclpGetSeconds
 #define TclpGetSeconds \
 	(tclIntStubsPtr->tclpGetSeconds) /* 76 */
+#endif
+#ifndef TclpGetTime
 #define TclpGetTime \
 	(tclIntStubsPtr->tclpGetTime) /* 77 */
-/* Slot 78 is reserved */
+#endif
+#ifndef TclpGetTimeZone
+#define TclpGetTimeZone \
+	(tclIntStubsPtr->tclpGetTimeZone) /* 78 */
+#endif
 /* Slot 79 is reserved */
 /* Slot 80 is reserved */
+#ifndef TclpRealloc
 #define TclpRealloc \
 	(tclIntStubsPtr->tclpRealloc) /* 81 */
+#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
 #define TclPrecTraceProc \
 	(tclIntStubsPtr->tclPrecTraceProc) /* 88 */
+#endif
+#ifndef TclPreventAliasLoop
 #define TclPreventAliasLoop \
 	(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
+#endif
 /* Slot 90 is reserved */
+#ifndef TclProcCleanupProc
 #define TclProcCleanupProc \
 	(tclIntStubsPtr->tclProcCleanupProc) /* 91 */
+#endif
+#ifndef TclProcCompileProc
 #define TclProcCompileProc \
 	(tclIntStubsPtr->tclProcCompileProc) /* 92 */
+#endif
+#ifndef TclProcDeleteProc
 #define TclProcDeleteProc \
 	(tclIntStubsPtr->tclProcDeleteProc) /* 93 */
-/* Slot 94 is reserved */
+#endif
+#ifndef TclProcInterpProc
+#define TclProcInterpProc \
+	(tclIntStubsPtr->tclProcInterpProc) /* 94 */
+#endif
 /* Slot 95 is reserved */
+#ifndef TclRenameCommand
 #define TclRenameCommand \
 	(tclIntStubsPtr->tclRenameCommand) /* 96 */
+#endif
+#ifndef TclResetShadowedCmdRefs
 #define TclResetShadowedCmdRefs \
 	(tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */
+#endif
+#ifndef TclServiceIdle
 #define TclServiceIdle \
 	(tclIntStubsPtr->tclServiceIdle) /* 98 */
+#endif
 /* Slot 99 is reserved */
 /* Slot 100 is reserved */
+#ifndef TclSetPreInitScript
 #define TclSetPreInitScript \
 	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
+#endif
+#ifndef TclSetupEnv
 #define TclSetupEnv \
 	(tclIntStubsPtr->tclSetupEnv) /* 102 */
+#endif
+#ifndef TclSockGetPort
 #define TclSockGetPort \
 	(tclIntStubsPtr->tclSockGetPort) /* 103 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclSockMinimumBuffersOld
 #define TclSockMinimumBuffersOld \
 	(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclSockMinimumBuffersOld
+#define TclSockMinimumBuffersOld \
+	(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
+#endif
+#endif /* __WIN32__ */
 /* Slot 105 is reserved */
-/* Slot 106 is reserved */
-/* Slot 107 is reserved */
+#ifndef TclStatDeleteProc
+#define TclStatDeleteProc \
+	(tclIntStubsPtr->tclStatDeleteProc) /* 106 */
+#endif
+#ifndef TclStatInsertProc
+#define TclStatInsertProc \
+	(tclIntStubsPtr->tclStatInsertProc) /* 107 */
+#endif
+#ifndef TclTeardownNamespace
 #define TclTeardownNamespace \
 	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
+#endif
+#ifndef TclUpdateReturnInfo
 #define TclUpdateReturnInfo \
 	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
+#endif
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclSockMinimumBuffers
 #define TclSockMinimumBuffers \
 	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
+#endif
+#endif /* UNIX */
+#ifdef __WIN32__
+#ifndef TclSockMinimumBuffers
+#define TclSockMinimumBuffers \
+	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
+#endif
+#endif /* __WIN32__ */
+#ifndef Tcl_AddInterpResolvers
 #define Tcl_AddInterpResolvers \
 	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
+#endif
+#ifndef Tcl_AppendExportList
 #define Tcl_AppendExportList \
 	(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
+#endif
+#ifndef Tcl_CreateNamespace
 #define Tcl_CreateNamespace \
 	(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
+#endif
+#ifndef Tcl_DeleteNamespace
 #define Tcl_DeleteNamespace \
 	(tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
+#endif
+#ifndef Tcl_Export
 #define Tcl_Export \
 	(tclIntStubsPtr->tcl_Export) /* 115 */
+#endif
+#ifndef Tcl_FindCommand
 #define Tcl_FindCommand \
 	(tclIntStubsPtr->tcl_FindCommand) /* 116 */
+#endif
+#ifndef Tcl_FindNamespace
 #define Tcl_FindNamespace \
 	(tclIntStubsPtr->tcl_FindNamespace) /* 117 */
+#endif
+#ifndef Tcl_GetInterpResolvers
 #define Tcl_GetInterpResolvers \
 	(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
+#endif
+#ifndef Tcl_GetNamespaceResolvers
 #define Tcl_GetNamespaceResolvers \
 	(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
+#endif
+#ifndef Tcl_FindNamespaceVar
 #define Tcl_FindNamespaceVar \
 	(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
+#endif
+#ifndef Tcl_ForgetImport
 #define Tcl_ForgetImport \
 	(tclIntStubsPtr->tcl_ForgetImport) /* 121 */
+#endif
+#ifndef Tcl_GetCommandFromObj
 #define Tcl_GetCommandFromObj \
 	(tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
+#endif
+#ifndef Tcl_GetCommandFullName
 #define Tcl_GetCommandFullName \
 	(tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
+#endif
+#ifndef Tcl_GetCurrentNamespace
 #define Tcl_GetCurrentNamespace \
 	(tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
+#endif
+#ifndef Tcl_GetGlobalNamespace
 #define Tcl_GetGlobalNamespace \
 	(tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
+#endif
+#ifndef Tcl_GetVariableFullName
 #define Tcl_GetVariableFullName \
 	(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
+#endif
+#ifndef Tcl_Import
 #define Tcl_Import \
 	(tclIntStubsPtr->tcl_Import) /* 127 */
+#endif
+#ifndef Tcl_PopCallFrame
 #define Tcl_PopCallFrame \
 	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
+#endif
+#ifndef Tcl_PushCallFrame
 #define Tcl_PushCallFrame \
 	(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
+#endif
+#ifndef Tcl_RemoveInterpResolvers
 #define Tcl_RemoveInterpResolvers \
 	(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
+#endif
+#ifndef Tcl_SetNamespaceResolvers
 #define Tcl_SetNamespaceResolvers \
 	(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
+#endif
+#ifndef TclpHasSockets
 #define TclpHasSockets \
 	(tclIntStubsPtr->tclpHasSockets) /* 132 */
+#endif
+#ifndef TclpGetDate
 #define TclpGetDate \
 	(tclIntStubsPtr->tclpGetDate) /* 133 */
-/* Slot 134 is reserved */
-/* Slot 135 is reserved */
+#endif
+#ifndef TclpStrftime
+#define TclpStrftime \
+	(tclIntStubsPtr->tclpStrftime) /* 134 */
+#endif
+#ifndef TclpCheckStackSpace
+#define TclpCheckStackSpace \
+	(tclIntStubsPtr->tclpCheckStackSpace) /* 135 */
+#endif
 /* Slot 136 is reserved */
 /* Slot 137 is reserved */
+#ifndef TclGetEnv
 #define TclGetEnv \
 	(tclIntStubsPtr->tclGetEnv) /* 138 */
+#endif
 /* Slot 139 is reserved */
-/* Slot 140 is reserved */
+#ifndef TclLooksLikeInt
+#define TclLooksLikeInt \
+	(tclIntStubsPtr->tclLooksLikeInt) /* 140 */
+#endif
+#ifndef TclpGetCwd
 #define TclpGetCwd \
 	(tclIntStubsPtr->tclpGetCwd) /* 141 */
+#endif
+#ifndef TclSetByteCodeFromAny
 #define TclSetByteCodeFromAny \
 	(tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */
+#endif
+#ifndef TclAddLiteralObj
 #define TclAddLiteralObj \
 	(tclIntStubsPtr->tclAddLiteralObj) /* 143 */
+#endif
+#ifndef TclHideLiteral
 #define TclHideLiteral \
 	(tclIntStubsPtr->tclHideLiteral) /* 144 */
+#endif
+#ifndef TclGetAuxDataType
 #define TclGetAuxDataType \
 	(tclIntStubsPtr->tclGetAuxDataType) /* 145 */
+#endif
+#ifndef TclHandleCreate
 #define TclHandleCreate \
 	(tclIntStubsPtr->tclHandleCreate) /* 146 */
+#endif
+#ifndef TclHandleFree
 #define TclHandleFree \
 	(tclIntStubsPtr->tclHandleFree) /* 147 */
+#endif
+#ifndef TclHandlePreserve
 #define TclHandlePreserve \
 	(tclIntStubsPtr->tclHandlePreserve) /* 148 */
+#endif
+#ifndef TclHandleRelease
 #define TclHandleRelease \
 	(tclIntStubsPtr->tclHandleRelease) /* 149 */
+#endif
+#ifndef TclRegAbout
 #define TclRegAbout \
 	(tclIntStubsPtr->tclRegAbout) /* 150 */
+#endif
+#ifndef TclRegExpRangeUniChar
 #define TclRegExpRangeUniChar \
 	(tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */
+#endif
+#ifndef TclSetLibraryPath
 #define TclSetLibraryPath \
 	(tclIntStubsPtr->tclSetLibraryPath) /* 152 */
+#endif
+#ifndef TclGetLibraryPath
 #define TclGetLibraryPath \
 	(tclIntStubsPtr->tclGetLibraryPath) /* 153 */
+#endif
 /* Slot 154 is reserved */
 /* Slot 155 is reserved */
+#ifndef TclRegError
 #define TclRegError \
 	(tclIntStubsPtr->tclRegError) /* 156 */
+#endif
+#ifndef TclVarTraceExists
 #define TclVarTraceExists \
 	(tclIntStubsPtr->tclVarTraceExists) /* 157 */
-/* Slot 158 is reserved */
-/* Slot 159 is reserved */
+#endif
+#ifndef TclSetStartupScriptFileName
+#define TclSetStartupScriptFileName \
+	(tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
+#endif
+#ifndef TclGetStartupScriptFileName
+#define TclGetStartupScriptFileName \
+	(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
+#endif
 /* Slot 160 is reserved */
+#ifndef TclChannelTransform
 #define TclChannelTransform \
 	(tclIntStubsPtr->tclChannelTransform) /* 161 */
+#endif
+#ifndef TclChannelEventScriptInvoker
 #define TclChannelEventScriptInvoker \
 	(tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */
+#endif
+#ifndef TclGetInstructionTable
 #define TclGetInstructionTable \
 	(tclIntStubsPtr->tclGetInstructionTable) /* 163 */
+#endif
+#ifndef TclExpandCodeArray
 #define TclExpandCodeArray \
 	(tclIntStubsPtr->tclExpandCodeArray) /* 164 */
+#endif
+#ifndef TclpSetInitialEncodings
 #define TclpSetInitialEncodings \
 	(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
+#endif
+#ifndef TclListObjSetElement
 #define TclListObjSetElement \
 	(tclIntStubsPtr->tclListObjSetElement) /* 166 */
-/* Slot 167 is reserved */
-/* Slot 168 is reserved */
+#endif
+#ifndef TclSetStartupScriptPath
+#define TclSetStartupScriptPath \
+	(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
+#endif
+#ifndef TclGetStartupScriptPath
+#define TclGetStartupScriptPath \
+	(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
+#endif
+#ifndef TclpUtfNcmp2
 #define TclpUtfNcmp2 \
 	(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
+#endif
+#ifndef TclCheckInterpTraces
 #define TclCheckInterpTraces \
 	(tclIntStubsPtr->tclCheckInterpTraces) /* 170 */
+#endif
+#ifndef TclCheckExecutionTraces
 #define TclCheckExecutionTraces \
 	(tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */
+#endif
+#ifndef TclInThreadExit
 #define TclInThreadExit \
 	(tclIntStubsPtr->tclInThreadExit) /* 172 */
+#endif
+#ifndef TclUniCharMatch
 #define TclUniCharMatch \
 	(tclIntStubsPtr->tclUniCharMatch) /* 173 */
+#endif
 /* Slot 174 is reserved */
-#define TclCallVarTraces \
-	(tclIntStubsPtr->tclCallVarTraces) /* 175 */
-#define TclCleanupVar \
-	(tclIntStubsPtr->tclCleanupVar) /* 176 */
-#define TclVarErrMsg \
-	(tclIntStubsPtr->tclVarErrMsg) /* 177 */
+/* Slot 175 is reserved */
+/* Slot 176 is reserved */
+/* Slot 177 is reserved */
 /* Slot 178 is reserved */
 /* Slot 179 is reserved */
 /* Slot 180 is reserved */
 /* Slot 181 is reserved */
+#ifndef TclpLocaltime
 #define TclpLocaltime \
 	(tclIntStubsPtr->tclpLocaltime) /* 182 */
+#endif
+#ifndef TclpGmtime
 #define TclpGmtime \
 	(tclIntStubsPtr->tclpGmtime) /* 183 */
+#endif
 /* Slot 184 is reserved */
 /* Slot 185 is reserved */
 /* Slot 186 is reserved */
@@ -1186,107 +1424,20 @@ extern const TclIntStubs *tclIntStubsPtr;
 /* Slot 195 is reserved */
 /* Slot 196 is reserved */
 /* Slot 197 is reserved */
-#define TclObjGetFrame \
-	(tclIntStubsPtr->tclObjGetFrame) /* 198 */
-/* Slot 199 is reserved */
-#define TclpObjRemoveDirectory \
-	(tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */
-#define TclpObjCopyDirectory \
-	(tclIntStubsPtr->tclpObjCopyDirectory) /* 201 */
-#define TclpObjCreateDirectory \
-	(tclIntStubsPtr->tclpObjCreateDirectory) /* 202 */
-#define TclpObjDeleteFile \
-	(tclIntStubsPtr->tclpObjDeleteFile) /* 203 */
-#define TclpObjCopyFile \
-	(tclIntStubsPtr->tclpObjCopyFile) /* 204 */
-#define TclpObjRenameFile \
-	(tclIntStubsPtr->tclpObjRenameFile) /* 205 */
-#define TclpObjStat \
-	(tclIntStubsPtr->tclpObjStat) /* 206 */
-#define TclpObjAccess \
-	(tclIntStubsPtr->tclpObjAccess) /* 207 */
-#define TclpOpenFileChannel \
-	(tclIntStubsPtr->tclpOpenFileChannel) /* 208 */
-/* Slot 209 is reserved */
-/* Slot 210 is reserved */
-/* Slot 211 is reserved */
-#define TclpFindExecutable \
-	(tclIntStubsPtr->tclpFindExecutable) /* 212 */
-#define TclGetObjNameOfExecutable \
-	(tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */
-#define TclSetObjNameOfExecutable \
-	(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
-#define TclStackAlloc \
-	(tclIntStubsPtr->tclStackAlloc) /* 215 */
-#define TclStackFree \
-	(tclIntStubsPtr->tclStackFree) /* 216 */
-#define TclPushStackFrame \
-	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
-#define TclPopStackFrame \
-	(tclIntStubsPtr->tclPopStackFrame) /* 218 */
-/* Slot 219 is reserved */
-/* Slot 220 is reserved */
-/* Slot 221 is reserved */
-/* Slot 222 is reserved */
-/* Slot 223 is reserved */
-#define TclGetPlatform \
-	(tclIntStubsPtr->tclGetPlatform) /* 224 */
-#define TclTraceDictPath \
-	(tclIntStubsPtr->tclTraceDictPath) /* 225 */
-#define TclObjBeingDeleted \
-	(tclIntStubsPtr->tclObjBeingDeleted) /* 226 */
-#define TclSetNsPath \
-	(tclIntStubsPtr->tclSetNsPath) /* 227 */
-/* Slot 228 is reserved */
-#define TclPtrMakeUpvar \
-	(tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */
-#define TclObjLookupVar \
-	(tclIntStubsPtr->tclObjLookupVar) /* 230 */
-#define TclGetNamespaceFromObj \
-	(tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */
-#define TclEvalObjEx \
-	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
-#define TclGetSrcInfoForPc \
-	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
-#define TclVarHashCreateVar \
-	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
-#define TclInitVarHashTable \
-	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
-/* Slot 236 is reserved */
-#define TclResetCancellation \
-	(tclIntStubsPtr->tclResetCancellation) /* 237 */
-#define TclNRInterpProc \
-	(tclIntStubsPtr->tclNRInterpProc) /* 238 */
-#define TclNRInterpProcCore \
-	(tclIntStubsPtr->tclNRInterpProcCore) /* 239 */
-#define TclNRRunCallbacks \
-	(tclIntStubsPtr->tclNRRunCallbacks) /* 240 */
-#define TclNREvalObjEx \
-	(tclIntStubsPtr->tclNREvalObjEx) /* 241 */
-#define TclNREvalObjv \
-	(tclIntStubsPtr->tclNREvalObjv) /* 242 */
-#define TclDbDumpActiveObjects \
-	(tclIntStubsPtr->tclDbDumpActiveObjects) /* 243 */
-#define TclGetNamespaceChildTable \
-	(tclIntStubsPtr->tclGetNamespaceChildTable) /* 244 */
-#define TclGetNamespaceCommandTable \
-	(tclIntStubsPtr->tclGetNamespaceCommandTable) /* 245 */
-#define TclInitRewriteEnsemble \
-	(tclIntStubsPtr->tclInitRewriteEnsemble) /* 246 */
-#define TclResetRewriteEnsemble \
-	(tclIntStubsPtr->tclResetRewriteEnsemble) /* 247 */
-#define TclCopyChannel \
-	(tclIntStubsPtr->tclCopyChannel) /* 248 */
-#define TclDoubleDigits \
-	(tclIntStubsPtr->tclDoubleDigits) /* 249 */
-#define TclSetSlaveCancelFlags \
-	(tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
+/* Slot 198 is reserved */
+#ifndef TclMatchIsTrivial
+#define TclMatchIsTrivial \
+	(tclIntStubsPtr->tclMatchIsTrivial) /* 199 */
+#endif
 
-#endif /* defined(USE_TCL_STUBS) */
+#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
+#if !defined(_WIN64)
+/* See bug 510001: TclSockMinimumBuffers needs plat imp */
+#   undef TclSockMinimumBuffers
+#   define TclSockMinimumBuffers(a,b) TclSockMinimumBuffersOld((int)(a),b)
+#endif
 
 #endif /* _TCLINTDECLS */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index bc0f4fd..63f9fe6 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -13,17 +13,6 @@
 #ifndef _TCLINTPLATDECLS
 #define _TCLINTPLATDECLS
 
-#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
@@ -36,614 +25,782 @@
  * Exported function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 0 */
-EXTERN void		TclWinConvertError(unsigned int errCode);
+EXTERN void		TclWinConvertError _ANSI_ARGS_((unsigned int errCode));
 /* 1 */
-EXTERN void		TclWinConvertWSAError(unsigned int errCode);
+EXTERN void		TclWinConvertWSAError _ANSI_ARGS_((
+				unsigned int errCode));
 /* 2 */
-EXTERN struct servent *	 TclWinGetServByName(const char *nm,
-				const char *proto);
+EXTERN struct servent *	 TclWinGetServByName _ANSI_ARGS_((CONST char *nm,
+				CONST char *proto));
 /* 3 */
-EXTERN int		TclWinGetSockOpt(void *s, int level, int optname,
-				char *optval, int *optlen);
+EXTERN int		TclWinGetSockOpt _ANSI_ARGS_((VOID *s, int level,
+				int optname, char *optval, int *optlen));
 /* 4 */
-EXTERN void *		TclWinGetTclInstance(void);
+EXTERN VOID *		TclWinGetTclInstance _ANSI_ARGS_((void));
 /* Slot 5 is reserved */
 /* 6 */
-EXTERN unsigned short	TclWinNToHS(unsigned short ns);
+EXTERN unsigned short	TclWinNToHS _ANSI_ARGS_((unsigned short ns));
 /* 7 */
-EXTERN int		TclWinSetSockOpt(void *s, int level, int optname,
-				const char *optval, int optlen);
+EXTERN int		TclWinSetSockOpt _ANSI_ARGS_((VOID *s, int level,
+				int optname, CONST char *optval, int optlen));
 /* 8 */
-EXTERN int		TclpGetPid(Tcl_Pid pid);
+EXTERN int		TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
 /* 9 */
-EXTERN int		TclWinGetPlatformId(void);
+EXTERN int		TclWinGetPlatformId _ANSI_ARGS_((void));
 /* 10 */
-EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
+EXTERN Tcl_DirEntry *	TclpReaddir _ANSI_ARGS_((DIR *dir));
 /* 11 */
-EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
+EXTERN struct tm *	TclpLocaltime_unix _ANSI_ARGS_((
+				TclpTime_t_CONST clock));
 /* 12 */
-EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
+EXTERN struct tm *	TclpGmtime_unix _ANSI_ARGS_((TclpTime_t_CONST clock));
 /* 13 */
-EXTERN void		TclIntPlatReserved13(void);
-/* 14 */
-EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
-				const Tcl_StatBuf *statBufPtr,
-				int dontCopyAtts);
+EXTERN void		TclIntPlatReserved13 _ANSI_ARGS_((void));
+/* Slot 14 is reserved */
 /* 15 */
-EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
-				int objIndex, Tcl_Obj *fileName,
-				Tcl_Obj **attributePtrPtr);
+EXTERN int		TclMacOSXGetFileAttribute _ANSI_ARGS_((
+				Tcl_Interp *interp, int objIndex,
+				Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr));
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
 /* 18 */
-EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
-				const char *pathName, const char *fileName,
+EXTERN int		TclMacOSXMatchType _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *pathName, CONST char *fileName,
 				Tcl_StatBuf *statBufPtr,
-				Tcl_GlobTypeData *types);
+				Tcl_GlobTypeData *types));
 /* 19 */
-EXTERN void		TclMacOSXNotifierAddRunLoopMode(
-				const void *runLoopMode);
+EXTERN void		TclMacOSXNotifierAddRunLoopMode _ANSI_ARGS_((
+				CONST VOID *runLoopMode));
 /* 20 */
-EXTERN void		TclWinAddProcess(void *hProcess, unsigned int id);
+EXTERN void		TclWinAddProcess _ANSI_ARGS_((VOID *hProcess,
+				unsigned int id));
 /* Slot 21 is reserved */
 /* 22 */
-EXTERN TclFile		TclpCreateTempFile(const char *contents);
+EXTERN TclFile		TclpCreateTempFile _ANSI_ARGS_((CONST char *contents));
 /* Slot 23 is reserved */
 /* 24 */
-EXTERN char *		TclWinNoBackslash(char *path);
+EXTERN char *		TclWinNoBackslash _ANSI_ARGS_((char *path));
 /* Slot 25 is reserved */
 /* 26 */
-EXTERN void		TclWinSetInterfaces(int wide);
+EXTERN void		TclWinSetInterfaces _ANSI_ARGS_((int wide));
 /* 27 */
-EXTERN void		TclWinFlushDirtyChannels(void);
+EXTERN void		TclWinFlushDirtyChannels _ANSI_ARGS_((void));
 /* 28 */
-EXTERN void		TclWinResetInterfaces(void);
+EXTERN void		TclWinResetInterfaces _ANSI_ARGS_((void));
 /* 29 */
-EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
+EXTERN int		TclWinCPUID _ANSI_ARGS_((unsigned int index,
+				unsigned int *regs));
 /* 30 */
-EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
-				Tcl_Channel chan);
+EXTERN void		TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan));
 /* 31 */
-EXTERN int		TclpCloseFile(TclFile file);
+EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
 /* 32 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
-				TclFile writeFile, TclFile errorFile,
-				int numPids, Tcl_Pid *pidPtr);
+EXTERN Tcl_Channel	TclpCreateCommandChannel _ANSI_ARGS_((
+				TclFile readFile, TclFile writeFile,
+				TclFile errorFile, int numPids,
+				Tcl_Pid *pidPtr));
 /* 33 */
-EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
+EXTERN int		TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe,
+				TclFile *writePipe));
 /* 34 */
-EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				const char **argv, TclFile inputFile,
-				TclFile outputFile, TclFile errorFile,
-				Tcl_Pid *pidPtr);
+EXTERN int		TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
+				int argc, CONST char **argv,
+				TclFile inputFile, TclFile outputFile,
+				TclFile errorFile, Tcl_Pid *pidPtr));
 /* 35 */
-EXTERN char *		TclpInetNtoa(struct in_addr addr);
+EXTERN char *		TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
 /* 36 */
-EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
+EXTERN TclFile		TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
+				int direction));
 /* 37 */
-EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
+EXTERN TclFile		TclpOpenFile _ANSI_ARGS_((CONST char *fname,
+				int mode));
 /* 38 */
-EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
+EXTERN int		TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask,
+				int timeout));
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#ifdef __WIN32__
 /* 0 */
-EXTERN void		TclWinConvertError(DWORD errCode);
+EXTERN void		TclWinConvertError _ANSI_ARGS_((DWORD errCode));
 /* 1 */
-EXTERN void		TclWinConvertWSAError(DWORD errCode);
+EXTERN void		TclWinConvertWSAError _ANSI_ARGS_((DWORD errCode));
 /* 2 */
-EXTERN struct servent *	 TclWinGetServByName(const char *nm,
-				const char *proto);
+EXTERN struct servent *	 TclWinGetServByName _ANSI_ARGS_((CONST char *nm,
+				CONST char *proto));
 /* 3 */
-EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
-				char *optval, int *optlen);
+EXTERN int		TclWinGetSockOpt _ANSI_ARGS_((SOCKET s, int level,
+				int optname, char *optval, int *optlen));
 /* 4 */
-EXTERN HINSTANCE	TclWinGetTclInstance(void);
+EXTERN HINSTANCE	TclWinGetTclInstance _ANSI_ARGS_((void));
 /* Slot 5 is reserved */
 /* 6 */
-EXTERN u_short		TclWinNToHS(u_short ns);
+EXTERN u_short		TclWinNToHS _ANSI_ARGS_((u_short ns));
 /* 7 */
-EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
-				const char *optval, int optlen);
+EXTERN int		TclWinSetSockOpt _ANSI_ARGS_((SOCKET s, int level,
+				int optname, CONST char *optval, int optlen));
 /* 8 */
-EXTERN int		TclpGetPid(Tcl_Pid pid);
+EXTERN int		TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
 /* 9 */
-EXTERN int		TclWinGetPlatformId(void);
+EXTERN int		TclWinGetPlatformId _ANSI_ARGS_((void));
 /* Slot 10 is reserved */
 /* 11 */
-EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
-				Tcl_Channel chan);
+EXTERN void		TclGetAndDetachPids _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Channel chan));
 /* 12 */
-EXTERN int		TclpCloseFile(TclFile file);
+EXTERN int		TclpCloseFile _ANSI_ARGS_((TclFile file));
 /* 13 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
-				TclFile writeFile, TclFile errorFile,
-				int numPids, Tcl_Pid *pidPtr);
+EXTERN Tcl_Channel	TclpCreateCommandChannel _ANSI_ARGS_((
+				TclFile readFile, TclFile writeFile,
+				TclFile errorFile, int numPids,
+				Tcl_Pid *pidPtr));
 /* 14 */
-EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
+EXTERN int		TclpCreatePipe _ANSI_ARGS_((TclFile *readPipe,
+				TclFile *writePipe));
 /* 15 */
-EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				const char **argv, TclFile inputFile,
-				TclFile outputFile, TclFile errorFile,
-				Tcl_Pid *pidPtr);
+EXTERN int		TclpCreateProcess _ANSI_ARGS_((Tcl_Interp *interp,
+				int argc, CONST char **argv,
+				TclFile inputFile, TclFile outputFile,
+				TclFile errorFile, Tcl_Pid *pidPtr));
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
 /* 18 */
-EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
+EXTERN TclFile		TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
+				int direction));
 /* 19 */
-EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
+EXTERN TclFile		TclpOpenFile _ANSI_ARGS_((CONST char *fname,
+				int mode));
 /* 20 */
-EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
+EXTERN void		TclWinAddProcess _ANSI_ARGS_((HANDLE hProcess,
+				DWORD id));
 /* Slot 21 is reserved */
 /* 22 */
-EXTERN TclFile		TclpCreateTempFile(const char *contents);
-/* Slot 23 is reserved */
+EXTERN TclFile		TclpCreateTempFile _ANSI_ARGS_((CONST char *contents));
+/* 23 */
+EXTERN char *		TclpGetTZName _ANSI_ARGS_((int isdst));
 /* 24 */
-EXTERN char *		TclWinNoBackslash(char *path);
-/* Slot 25 is reserved */
+EXTERN char *		TclWinNoBackslash _ANSI_ARGS_((char *path));
+/* 25 */
+EXTERN TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void));
 /* 26 */
-EXTERN void		TclWinSetInterfaces(int wide);
+EXTERN void		TclWinSetInterfaces _ANSI_ARGS_((int wide));
 /* 27 */
-EXTERN void		TclWinFlushDirtyChannels(void);
+EXTERN void		TclWinFlushDirtyChannels _ANSI_ARGS_((void));
 /* 28 */
-EXTERN void		TclWinResetInterfaces(void);
+EXTERN void		TclWinResetInterfaces _ANSI_ARGS_((void));
 /* 29 */
-EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
+EXTERN int		TclWinCPUID _ANSI_ARGS_((unsigned int index,
+				unsigned int *regs));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
 /* 0 */
-EXTERN void		TclWinConvertError(unsigned int errCode);
+EXTERN VOID *		TclpSysAlloc _ANSI_ARGS_((long size, int isBin));
 /* 1 */
-EXTERN void		TclWinConvertWSAError(unsigned int errCode);
+EXTERN void		TclpSysFree _ANSI_ARGS_((VOID *ptr));
 /* 2 */
-EXTERN struct servent *	 TclWinGetServByName(const char *nm,
-				const char *proto);
+EXTERN VOID *		TclpSysRealloc _ANSI_ARGS_((VOID *cp,
+				unsigned int size));
 /* 3 */
-EXTERN int		TclWinGetSockOpt(void *s, int level, int optname,
-				char *optval, int *optlen);
+EXTERN void		TclpExit _ANSI_ARGS_((int status));
 /* 4 */
-EXTERN void *		TclWinGetTclInstance(void);
-/* Slot 5 is reserved */
+EXTERN int		FSpGetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
+/* 5 */
+EXTERN int		FSpSetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
 /* 6 */
-EXTERN unsigned short	TclWinNToHS(unsigned short ns);
+EXTERN OSErr		FSpFindFolder _ANSI_ARGS_((short vRefNum,
+				OSType folderType, Boolean createFolder,
+				FSSpec *spec));
 /* 7 */
-EXTERN int		TclWinSetSockOpt(void *s, int level, int optname,
-				const char *optval, int optlen);
+EXTERN void		GetGlobalMouseTcl _ANSI_ARGS_((Point *mouse));
 /* 8 */
-EXTERN int		TclpGetPid(Tcl_Pid pid);
+EXTERN pascal OSErr	FSpGetDirectoryIDTcl _ANSI_ARGS_((CONST FSSpec *spec,
+				long *theDirID, Boolean *isDirectory));
 /* 9 */
-EXTERN int		TclWinGetPlatformId(void);
+EXTERN pascal short	FSpOpenResFileCompatTcl _ANSI_ARGS_((
+				CONST FSSpec *spec, SignedByte permission));
 /* 10 */
-EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
+EXTERN pascal void	FSpCreateResFileCompatTcl _ANSI_ARGS_((
+				CONST FSSpec *spec, OSType creator,
+				OSType fileType, ScriptCode scriptTag));
 /* 11 */
-EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
+EXTERN int		FSpLocationFromPath _ANSI_ARGS_((int length,
+				CONST char *path, FSSpecPtr theSpec));
 /* 12 */
-EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
+EXTERN OSErr		FSpPathFromLocation _ANSI_ARGS_((FSSpecPtr theSpec,
+				int *length, Handle *fullPath));
 /* 13 */
-EXTERN void		TclIntPlatReserved13(void);
+EXTERN void		TclMacExitHandler _ANSI_ARGS_((void));
 /* 14 */
-EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
-				const Tcl_StatBuf *statBufPtr,
-				int dontCopyAtts);
+EXTERN void		TclMacInitExitToShell _ANSI_ARGS_((int usePatch));
 /* 15 */
-EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
-				int objIndex, Tcl_Obj *fileName,
-				Tcl_Obj **attributePtrPtr);
+EXTERN OSErr		TclMacInstallExitToShellPatch _ANSI_ARGS_((
+				ExitToShellProcPtr newProc));
 /* 16 */
-EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
-				int objIndex, Tcl_Obj *fileName,
-				Tcl_Obj *attributePtr);
+EXTERN int		TclMacOSErrorToPosixError _ANSI_ARGS_((int error));
 /* 17 */
-EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
-				const char *dst,
-				const Tcl_StatBuf *statBufPtr);
+EXTERN void		TclMacRemoveTimer _ANSI_ARGS_((VOID *timerToken));
 /* 18 */
-EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
-				const char *pathName, const char *fileName,
-				Tcl_StatBuf *statBufPtr,
-				Tcl_GlobTypeData *types);
+EXTERN VOID *		TclMacStartTimer _ANSI_ARGS_((long ms));
 /* 19 */
-EXTERN void		TclMacOSXNotifierAddRunLoopMode(
-				const void *runLoopMode);
+EXTERN int		TclMacTimerExpired _ANSI_ARGS_((VOID *timerToken));
 /* 20 */
-EXTERN void		TclWinAddProcess(void *hProcess, unsigned int id);
-/* Slot 21 is reserved */
+EXTERN int		TclMacRegisterResourceFork _ANSI_ARGS_((
+				short fileRef, Tcl_Obj *tokenPtr, int insert));
+/* 21 */
+EXTERN short		TclMacUnRegisterResourceFork _ANSI_ARGS_((
+				char *tokenPtr, Tcl_Obj *resultPtr));
 /* 22 */
-EXTERN TclFile		TclpCreateTempFile(const char *contents);
-/* Slot 23 is reserved */
+EXTERN int		TclMacCreateEnv _ANSI_ARGS_((void));
+/* 23 */
+EXTERN FILE *		TclMacFOpenHack _ANSI_ARGS_((CONST char *path,
+				CONST char *mode));
 /* 24 */
-EXTERN char *		TclWinNoBackslash(char *path);
-/* Slot 25 is reserved */
+EXTERN char *		TclpGetTZName _ANSI_ARGS_((int isdst));
+/* 25 */
+EXTERN int		TclMacChmod _ANSI_ARGS_((CONST char *path, int mode));
 /* 26 */
-EXTERN void		TclWinSetInterfaces(int wide);
-/* 27 */
-EXTERN void		TclWinFlushDirtyChannels(void);
-/* 28 */
-EXTERN void		TclWinResetInterfaces(void);
-/* 29 */
-EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
-/* 30 */
-EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
-				Tcl_Channel chan);
-/* 31 */
-EXTERN int		TclpCloseFile(TclFile file);
-/* 32 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
-				TclFile writeFile, TclFile errorFile,
-				int numPids, Tcl_Pid *pidPtr);
-/* 33 */
-EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
-/* 34 */
-EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				const char **argv, TclFile inputFile,
-				TclFile outputFile, TclFile errorFile,
-				Tcl_Pid *pidPtr);
-/* 35 */
-EXTERN char *		TclpInetNtoa(struct in_addr addr);
-/* 36 */
-EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
-/* 37 */
-EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
-/* 38 */
-EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
-#endif /* MACOSX */
+EXTERN int		FSpLLocationFromPath _ANSI_ARGS_((int length,
+				CONST char *path, FSSpecPtr theSpec));
+#endif /* MAC_TCL */
 
 typedef struct TclIntPlatStubs {
     int magic;
-    const struct TclIntPlatStubHooks *hooks;
+    struct TclIntPlatStubHooks *hooks;
 
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-    void (*tclWinConvertError) (unsigned int errCode); /* 0 */
-    void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */
-    struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
-    int (*tclWinGetSockOpt) (void *s, int level, int optname, char *optval, int *optlen); /* 3 */
-    void * (*tclWinGetTclInstance) (void); /* 4 */
-    void (*reserved5)(void);
-    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
-    int (*tclWinSetSockOpt) (void *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 */
-    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
-    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
-    void (*tclIntPlatReserved13) (void); /* 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 */
-    void (*reserved16)(void);
-    void (*reserved17)(void);
-    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 (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */
-    void (*reserved21)(void);
-    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
-    void (*reserved23)(void);
-    char * (*tclWinNoBackslash) (char *path); /* 24 */
-    void (*reserved25)(void);
-    void (*tclWinSetInterfaces) (int wide); /* 26 */
-    void (*tclWinFlushDirtyChannels) (void); /* 27 */
-    void (*tclWinResetInterfaces) (void); /* 28 */
-    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
-    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */
-    int (*tclpCloseFile) (TclFile file); /* 31 */
-    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 32 */
-    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 33 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 34 */
-    char * (*tclpInetNtoa) (struct in_addr addr); /* 35 */
-    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 36 */
-    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 37 */
-    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 38 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    void (*tclWinConvertError) _ANSI_ARGS_((unsigned int errCode)); /* 0 */
+    void (*tclWinConvertWSAError) _ANSI_ARGS_((unsigned int errCode)); /* 1 */
+    struct servent * (*tclWinGetServByName) _ANSI_ARGS_((CONST char *nm, CONST char *proto)); /* 2 */
+    int (*tclWinGetSockOpt) _ANSI_ARGS_((VOID *s, int level, int optname, char *optval, int *optlen)); /* 3 */
+    VOID * (*tclWinGetTclInstance) _ANSI_ARGS_((void)); /* 4 */
+    VOID *reserved5;
+    unsigned short (*tclWinNToHS) _ANSI_ARGS_((unsigned short ns)); /* 6 */
+    int (*tclWinSetSockOpt) _ANSI_ARGS_((VOID *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 */
+    struct tm * (*tclpLocaltime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 11 */
+    struct tm * (*tclpGmtime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 12 */
+    void (*tclIntPlatReserved13) _ANSI_ARGS_((void)); /* 13 */
+    VOID *reserved14;
+    int (*tclMacOSXGetFileAttribute) _ANSI_ARGS_((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)); /* 15 */
+    VOID *reserved16;
+    VOID *reserved17;
+    int (*tclMacOSXMatchType) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *pathName, CONST char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types)); /* 18 */
+    void (*tclMacOSXNotifierAddRunLoopMode) _ANSI_ARGS_((CONST VOID *runLoopMode)); /* 19 */
+    void (*tclWinAddProcess) _ANSI_ARGS_((VOID *hProcess, unsigned int id)); /* 20 */
+    VOID *reserved21;
+    TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char *contents)); /* 22 */
+    VOID *reserved23;
+    char * (*tclWinNoBackslash) _ANSI_ARGS_((char *path)); /* 24 */
+    VOID *reserved25;
+    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 (*tclGetAndDetachPids) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Channel chan)); /* 30 */
+    int (*tclpCloseFile) _ANSI_ARGS_((TclFile file)); /* 31 */
+    Tcl_Channel (*tclpCreateCommandChannel) _ANSI_ARGS_((TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)); /* 32 */
+    int (*tclpCreatePipe) _ANSI_ARGS_((TclFile *readPipe, TclFile *writePipe)); /* 33 */
+    int (*tclpCreateProcess) _ANSI_ARGS_((Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr)); /* 34 */
+    char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 35 */
+    TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 36 */
+    TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char *fname, int mode)); /* 37 */
+    int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 38 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    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 */
-    void (*reserved5)(void);
-    u_short (*tclWinNToHS) (u_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 */
-    void (*reserved10)(void);
-    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 */
-    void (*reserved16)(void);
-    void (*reserved17)(void);
-    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
-    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
-    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
-    void (*reserved21)(void);
-    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
-    void (*reserved23)(void);
-    char * (*tclWinNoBackslash) (char *path); /* 24 */
-    void (*reserved25)(void);
-    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 (*tclWinConvertError) (unsigned int errCode); /* 0 */
-    void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */
-    struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
-    int (*tclWinGetSockOpt) (void *s, int level, int optname, char *optval, int *optlen); /* 3 */
-    void * (*tclWinGetTclInstance) (void); /* 4 */
-    void (*reserved5)(void);
-    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
-    int (*tclWinSetSockOpt) (void *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 */
-    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
-    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
-    void (*tclIntPlatReserved13) (void); /* 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 (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */
-    void (*reserved21)(void);
-    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
-    void (*reserved23)(void);
-    char * (*tclWinNoBackslash) (char *path); /* 24 */
-    void (*reserved25)(void);
-    void (*tclWinSetInterfaces) (int wide); /* 26 */
-    void (*tclWinFlushDirtyChannels) (void); /* 27 */
-    void (*tclWinResetInterfaces) (void); /* 28 */
-    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
-    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */
-    int (*tclpCloseFile) (TclFile file); /* 31 */
-    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 32 */
-    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 33 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 34 */
-    char * (*tclpInetNtoa) (struct in_addr addr); /* 35 */
-    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 36 */
-    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 37 */
-    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 38 */
-#endif /* MACOSX */
+#ifdef __WIN32__
+    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 */
+    VOID *reserved5;
+    u_short (*tclWinNToHS) _ANSI_ARGS_((u_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 */
+    VOID *reserved10;
+    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 */
+    VOID *reserved16;
+    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 */
+    VOID *reserved21;
+    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 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    VOID * (*tclpSysAlloc) _ANSI_ARGS_((long size, int isBin)); /* 0 */
+    void (*tclpSysFree) _ANSI_ARGS_((VOID *ptr)); /* 1 */
+    VOID * (*tclpSysRealloc) _ANSI_ARGS_((VOID *cp, unsigned int size)); /* 2 */
+    void (*tclpExit) _ANSI_ARGS_((int status)); /* 3 */
+    int (*fSpGetDefaultDir) _ANSI_ARGS_((FSSpecPtr theSpec)); /* 4 */
+    int (*fSpSetDefaultDir) _ANSI_ARGS_((FSSpecPtr theSpec)); /* 5 */
+    OSErr (*fSpFindFolder) _ANSI_ARGS_((short vRefNum, OSType folderType, Boolean createFolder, FSSpec *spec)); /* 6 */
+    void (*getGlobalMouseTcl) _ANSI_ARGS_((Point *mouse)); /* 7 */
+    pascal OSErr (*fSpGetDirectoryIDTcl) _ANSI_ARGS_((CONST FSSpec *spec, long *theDirID, Boolean *isDirectory)); /* 8 */
+    pascal short (*fSpOpenResFileCompatTcl) _ANSI_ARGS_((CONST FSSpec *spec, SignedByte permission)); /* 9 */
+    pascal void (*fSpCreateResFileCompatTcl) _ANSI_ARGS_((CONST FSSpec *spec, OSType creator, OSType fileType, ScriptCode scriptTag)); /* 10 */
+    int (*fSpLocationFromPath) _ANSI_ARGS_((int length, CONST char *path, FSSpecPtr theSpec)); /* 11 */
+    OSErr (*fSpPathFromLocation) _ANSI_ARGS_((FSSpecPtr theSpec, int *length, Handle *fullPath)); /* 12 */
+    void (*tclMacExitHandler) _ANSI_ARGS_((void)); /* 13 */
+    void (*tclMacInitExitToShell) _ANSI_ARGS_((int usePatch)); /* 14 */
+    OSErr (*tclMacInstallExitToShellPatch) _ANSI_ARGS_((ExitToShellProcPtr newProc)); /* 15 */
+    int (*tclMacOSErrorToPosixError) _ANSI_ARGS_((int error)); /* 16 */
+    void (*tclMacRemoveTimer) _ANSI_ARGS_((VOID *timerToken)); /* 17 */
+    VOID * (*tclMacStartTimer) _ANSI_ARGS_((long ms)); /* 18 */
+    int (*tclMacTimerExpired) _ANSI_ARGS_((VOID *timerToken)); /* 19 */
+    int (*tclMacRegisterResourceFork) _ANSI_ARGS_((short fileRef, Tcl_Obj *tokenPtr, int insert)); /* 20 */
+    short (*tclMacUnRegisterResourceFork) _ANSI_ARGS_((char *tokenPtr, Tcl_Obj *resultPtr)); /* 21 */
+    int (*tclMacCreateEnv) _ANSI_ARGS_((void)); /* 22 */
+    FILE * (*tclMacFOpenHack) _ANSI_ARGS_((CONST char *path, CONST char *mode)); /* 23 */
+    char * (*tclpGetTZName) _ANSI_ARGS_((int isdst)); /* 24 */
+    int (*tclMacChmod) _ANSI_ARGS_((CONST char *path, int mode)); /* 25 */
+    int (*fSpLLocationFromPath) _ANSI_ARGS_((int length, CONST char *path, FSSpecPtr theSpec)); /* 26 */
+#endif /* MAC_TCL */
 } TclIntPlatStubs;
 
 #ifdef __cplusplus
 extern "C" {
 #endif
-extern const TclIntPlatStubs *tclIntPlatStubsPtr;
+extern TclIntPlatStubs *tclIntPlatStubsPtr;
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS)
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
 
 /*
  * Inline function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef TclWinConvertError
 #define TclWinConvertError \
 	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
+#endif
+#ifndef TclWinConvertWSAError
 #define TclWinConvertWSAError \
 	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
+#endif
+#ifndef TclWinGetServByName
 #define TclWinGetServByName \
 	(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
+#endif
+#ifndef TclWinGetSockOpt
 #define TclWinGetSockOpt \
 	(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
+#endif
+#ifndef TclWinGetTclInstance
 #define TclWinGetTclInstance \
 	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
+#endif
 /* Slot 5 is reserved */
+#ifndef TclWinNToHS
 #define TclWinNToHS \
 	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
+#endif
+#ifndef TclWinSetSockOpt
 #define TclWinSetSockOpt \
 	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
+#endif
+#ifndef TclpGetPid
 #define TclpGetPid \
 	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
+#endif
+#ifndef TclWinGetPlatformId
 #define TclWinGetPlatformId \
 	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
+#endif
+#ifndef TclpReaddir
 #define TclpReaddir \
 	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
+#endif
+#ifndef TclpLocaltime_unix
 #define TclpLocaltime_unix \
 	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
+#endif
+#ifndef TclpGmtime_unix
 #define TclpGmtime_unix \
 	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
+#endif
+#ifndef TclIntPlatReserved13
 #define TclIntPlatReserved13 \
 	(tclIntPlatStubsPtr->tclIntPlatReserved13) /* 13 */
-#define TclUnixCopyFile \
-	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
+#endif
+/* Slot 14 is reserved */
+#ifndef TclMacOSXGetFileAttribute
 #define TclMacOSXGetFileAttribute \
 	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
+#endif
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
+#ifndef TclMacOSXMatchType
 #define TclMacOSXMatchType \
 	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
+#endif
+#ifndef TclMacOSXNotifierAddRunLoopMode
 #define TclMacOSXNotifierAddRunLoopMode \
 	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
+#endif
+#ifndef TclWinAddProcess
 #define TclWinAddProcess \
 	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
+#endif
 /* Slot 21 is reserved */
+#ifndef TclpCreateTempFile
 #define TclpCreateTempFile \
 	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
+#endif
 /* Slot 23 is reserved */
+#ifndef TclWinNoBackslash
 #define TclWinNoBackslash \
 	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
+#endif
 /* Slot 25 is reserved */
+#ifndef TclWinSetInterfaces
 #define TclWinSetInterfaces \
 	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
+#endif
+#ifndef TclWinFlushDirtyChannels
 #define TclWinFlushDirtyChannels \
 	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
+#endif
+#ifndef TclWinResetInterfaces
 #define TclWinResetInterfaces \
 	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
+#endif
+#ifndef TclWinCPUID
 #define TclWinCPUID \
 	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
+#endif
+#ifndef TclGetAndDetachPids
 #define TclGetAndDetachPids \
 	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */
+#endif
+#ifndef TclpCloseFile
 #define TclpCloseFile \
 	(tclIntPlatStubsPtr->tclpCloseFile) /* 31 */
+#endif
+#ifndef TclpCreateCommandChannel
 #define TclpCreateCommandChannel \
 	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 32 */
+#endif
+#ifndef TclpCreatePipe
 #define TclpCreatePipe \
 	(tclIntPlatStubsPtr->tclpCreatePipe) /* 33 */
+#endif
+#ifndef TclpCreateProcess
 #define TclpCreateProcess \
 	(tclIntPlatStubsPtr->tclpCreateProcess) /* 34 */
+#endif
+#ifndef TclpInetNtoa
 #define TclpInetNtoa \
 	(tclIntPlatStubsPtr->tclpInetNtoa) /* 35 */
+#endif
+#ifndef TclpMakeFile
 #define TclpMakeFile \
 	(tclIntPlatStubsPtr->tclpMakeFile) /* 36 */
+#endif
+#ifndef TclpOpenFile
 #define TclpOpenFile \
 	(tclIntPlatStubsPtr->tclpOpenFile) /* 37 */
+#endif
+#ifndef TclUnixWaitForFile
 #define TclUnixWaitForFile \
 	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 38 */
+#endif
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#ifdef __WIN32__
+#ifndef TclWinConvertError
 #define TclWinConvertError \
 	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
+#endif
+#ifndef TclWinConvertWSAError
 #define TclWinConvertWSAError \
 	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
+#endif
+#ifndef TclWinGetServByName
 #define TclWinGetServByName \
 	(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
+#endif
+#ifndef TclWinGetSockOpt
 #define TclWinGetSockOpt \
 	(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
+#endif
+#ifndef TclWinGetTclInstance
 #define TclWinGetTclInstance \
 	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
+#endif
 /* Slot 5 is reserved */
+#ifndef TclWinNToHS
 #define TclWinNToHS \
 	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
+#endif
+#ifndef TclWinSetSockOpt
 #define TclWinSetSockOpt \
 	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
+#endif
+#ifndef TclpGetPid
 #define TclpGetPid \
 	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
+#endif
+#ifndef TclWinGetPlatformId
 #define TclWinGetPlatformId \
 	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
+#endif
 /* Slot 10 is reserved */
+#ifndef TclGetAndDetachPids
 #define TclGetAndDetachPids \
 	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
+#endif
+#ifndef TclpCloseFile
 #define TclpCloseFile \
 	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
+#endif
+#ifndef TclpCreateCommandChannel
 #define TclpCreateCommandChannel \
 	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
+#endif
+#ifndef TclpCreatePipe
 #define TclpCreatePipe \
 	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
+#endif
+#ifndef TclpCreateProcess
 #define TclpCreateProcess \
 	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
+#endif
 /* Slot 16 is reserved */
 /* Slot 17 is reserved */
+#ifndef TclpMakeFile
 #define TclpMakeFile \
 	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
+#endif
+#ifndef TclpOpenFile
 #define TclpOpenFile \
 	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
+#endif
+#ifndef TclWinAddProcess
 #define TclWinAddProcess \
 	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
+#endif
 /* Slot 21 is reserved */
+#ifndef TclpCreateTempFile
 #define TclpCreateTempFile \
 	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
-/* Slot 23 is reserved */
-#define TclWinNoBackslash \
-	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
-/* Slot 25 is reserved */
-#define TclWinSetInterfaces \
-	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
-#define TclWinFlushDirtyChannels \
-	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
-#define TclWinResetInterfaces \
-	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
-#define TclWinCPUID \
-	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#define TclWinConvertError \
-	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
-#define TclWinConvertWSAError \
-	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
-#define TclWinGetServByName \
-	(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
-#define TclWinGetSockOpt \
-	(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
-#define TclWinGetTclInstance \
-	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
-/* Slot 5 is reserved */
-#define TclWinNToHS \
-	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
-#define TclWinSetSockOpt \
-	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
-#define TclpGetPid \
-	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
-#define TclWinGetPlatformId \
-	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
-#define TclpReaddir \
-	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
-#define TclpLocaltime_unix \
-	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
-#define TclpGmtime_unix \
-	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
-#define TclIntPlatReserved13 \
-	(tclIntPlatStubsPtr->tclIntPlatReserved13) /* 13 */
-#define TclUnixCopyFile \
-	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
-#define TclMacOSXGetFileAttribute \
-	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
-#define TclMacOSXSetFileAttribute \
-	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
-#define TclMacOSXCopyFileAttributes \
-	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
-#define TclMacOSXMatchType \
-	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
-#define TclMacOSXNotifierAddRunLoopMode \
-	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
-#define TclWinAddProcess \
-	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
-/* Slot 21 is reserved */
-#define TclpCreateTempFile \
-	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
-/* Slot 23 is reserved */
+#endif
+#ifndef TclpGetTZName
+#define TclpGetTZName \
+	(tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
+#endif
+#ifndef TclWinNoBackslash
 #define TclWinNoBackslash \
 	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
-/* Slot 25 is reserved */
+#endif
+#ifndef TclWinGetPlatform
+#define TclWinGetPlatform \
+	(tclIntPlatStubsPtr->tclWinGetPlatform) /* 25 */
+#endif
+#ifndef TclWinSetInterfaces
 #define TclWinSetInterfaces \
 	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
+#endif
+#ifndef TclWinFlushDirtyChannels
 #define TclWinFlushDirtyChannels \
 	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
+#endif
+#ifndef TclWinResetInterfaces
 #define TclWinResetInterfaces \
 	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
+#endif
+#ifndef TclWinCPUID
 #define TclWinCPUID \
 	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#define TclGetAndDetachPids \
-	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */
-#define TclpCloseFile \
-	(tclIntPlatStubsPtr->tclpCloseFile) /* 31 */
-#define TclpCreateCommandChannel \
-	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 32 */
-#define TclpCreatePipe \
-	(tclIntPlatStubsPtr->tclpCreatePipe) /* 33 */
-#define TclpCreateProcess \
-	(tclIntPlatStubsPtr->tclpCreateProcess) /* 34 */
-#define TclpInetNtoa \
-	(tclIntPlatStubsPtr->tclpInetNtoa) /* 35 */
-#define TclpMakeFile \
-	(tclIntPlatStubsPtr->tclpMakeFile) /* 36 */
-#define TclpOpenFile \
-	(tclIntPlatStubsPtr->tclpOpenFile) /* 37 */
-#define TclUnixWaitForFile \
-	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 38 */
-#endif /* MACOSX */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef TclpSysAlloc
+#define TclpSysAlloc \
+	(tclIntPlatStubsPtr->tclpSysAlloc) /* 0 */
+#endif
+#ifndef TclpSysFree
+#define TclpSysFree \
+	(tclIntPlatStubsPtr->tclpSysFree) /* 1 */
+#endif
+#ifndef TclpSysRealloc
+#define TclpSysRealloc \
+	(tclIntPlatStubsPtr->tclpSysRealloc) /* 2 */
+#endif
+#ifndef TclpExit
+#define TclpExit \
+	(tclIntPlatStubsPtr->tclpExit) /* 3 */
+#endif
+#ifndef FSpGetDefaultDir
+#define FSpGetDefaultDir \
+	(tclIntPlatStubsPtr->fSpGetDefaultDir) /* 4 */
+#endif
+#ifndef FSpSetDefaultDir
+#define FSpSetDefaultDir \
+	(tclIntPlatStubsPtr->fSpSetDefaultDir) /* 5 */
+#endif
+#ifndef FSpFindFolder
+#define FSpFindFolder \
+	(tclIntPlatStubsPtr->fSpFindFolder) /* 6 */
+#endif
+#ifndef GetGlobalMouseTcl
+#define GetGlobalMouseTcl \
+	(tclIntPlatStubsPtr->getGlobalMouseTcl) /* 7 */
+#endif
+#ifndef FSpGetDirectoryIDTcl
+#define FSpGetDirectoryIDTcl \
+	(tclIntPlatStubsPtr->fSpGetDirectoryIDTcl) /* 8 */
+#endif
+#ifndef FSpOpenResFileCompatTcl
+#define FSpOpenResFileCompatTcl \
+	(tclIntPlatStubsPtr->fSpOpenResFileCompatTcl) /* 9 */
+#endif
+#ifndef FSpCreateResFileCompatTcl
+#define FSpCreateResFileCompatTcl \
+	(tclIntPlatStubsPtr->fSpCreateResFileCompatTcl) /* 10 */
+#endif
+#ifndef FSpLocationFromPath
+#define FSpLocationFromPath \
+	(tclIntPlatStubsPtr->fSpLocationFromPath) /* 11 */
+#endif
+#ifndef FSpPathFromLocation
+#define FSpPathFromLocation \
+	(tclIntPlatStubsPtr->fSpPathFromLocation) /* 12 */
+#endif
+#ifndef TclMacExitHandler
+#define TclMacExitHandler \
+	(tclIntPlatStubsPtr->tclMacExitHandler) /* 13 */
+#endif
+#ifndef TclMacInitExitToShell
+#define TclMacInitExitToShell \
+	(tclIntPlatStubsPtr->tclMacInitExitToShell) /* 14 */
+#endif
+#ifndef TclMacInstallExitToShellPatch
+#define TclMacInstallExitToShellPatch \
+	(tclIntPlatStubsPtr->tclMacInstallExitToShellPatch) /* 15 */
+#endif
+#ifndef TclMacOSErrorToPosixError
+#define TclMacOSErrorToPosixError \
+	(tclIntPlatStubsPtr->tclMacOSErrorToPosixError) /* 16 */
+#endif
+#ifndef TclMacRemoveTimer
+#define TclMacRemoveTimer \
+	(tclIntPlatStubsPtr->tclMacRemoveTimer) /* 17 */
+#endif
+#ifndef TclMacStartTimer
+#define TclMacStartTimer \
+	(tclIntPlatStubsPtr->tclMacStartTimer) /* 18 */
+#endif
+#ifndef TclMacTimerExpired
+#define TclMacTimerExpired \
+	(tclIntPlatStubsPtr->tclMacTimerExpired) /* 19 */
+#endif
+#ifndef TclMacRegisterResourceFork
+#define TclMacRegisterResourceFork \
+	(tclIntPlatStubsPtr->tclMacRegisterResourceFork) /* 20 */
+#endif
+#ifndef TclMacUnRegisterResourceFork
+#define TclMacUnRegisterResourceFork \
+	(tclIntPlatStubsPtr->tclMacUnRegisterResourceFork) /* 21 */
+#endif
+#ifndef TclMacCreateEnv
+#define TclMacCreateEnv \
+	(tclIntPlatStubsPtr->tclMacCreateEnv) /* 22 */
+#endif
+#ifndef TclMacFOpenHack
+#define TclMacFOpenHack \
+	(tclIntPlatStubsPtr->tclMacFOpenHack) /* 23 */
+#endif
+#ifndef TclpGetTZName
+#define TclpGetTZName \
+	(tclIntPlatStubsPtr->tclpGetTZName) /* 24 */
+#endif
+#ifndef TclMacChmod
+#define TclMacChmod \
+	(tclIntPlatStubsPtr->tclMacChmod) /* 25 */
+#endif
+#ifndef FSpLLocationFromPath
+#define FSpLLocationFromPath \
+	(tclIntPlatStubsPtr->fSpLLocationFromPath) /* 26 */
+#endif
+#endif /* MAC_TCL */
 
-#endif /* defined(USE_TCL_STUBS) */
+#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
 #undef TclpLocaltime_unix
 #undef TclpGmtime_unix
 #undef TclIntPlatReserved13
-#undef TclWinConvertWSAError
-#define TclWinConvertWSAError TclWinConvertError
 
-#if !defined(__WIN32__)
+#if !defined(__WIN32__) && !defined(MAC_TCL)
 # undef TclpGetPid
 # define TclpGetPid(pid) ((unsigned long) (pid))
+
+# if defined(USE_TCL_STUBS)
+#   undef TclpCreateProcess
+#   undef TclpMakeFile
+#   undef TclpOpenFile
+#   undef TclpCreateCommandChannel
+#   ifdef __CYGWIN__
+#	define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \
+		CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \
+		tclIntPlatStubsPtr->tclMacOSXGetFileAttribute)
+#	define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \
+	    int direction))) tclIntPlatStubsPtr->tclMacOSXMatchType)
+#	define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \
+	    tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode)
+#   define TclpCreateCommandChannel ((Tcl_Channel (*) _ANSI_ARGS_((TclFile, TclFile, \
+	    TclFile, int, Tcl_Pid *))) tclIntPlatStubsPtr->tclIntPlatReserved13)
+#   else
+#	define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \
+		CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \
+		tclIntPlatStubsPtr->tclWinGetTclInstance)
+#	define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \
+	    int direction))) tclIntPlatStubsPtr->tclWinNToHS)
+#	define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \
+	    tclIntPlatStubsPtr->tclWinSetSockOpt)
+#   define TclpCreateCommandChannel ((Tcl_Channel (*) _ANSI_ARGS_((TclFile, TclFile, \
+	    TclFile, int, Tcl_Pid *))) tclIntPlatStubsPtr->tclWinGetServByName)
+
+#	undef TclpCreateTempFile
+#	undef TclGetAndDetachPids
+#	undef TclpCloseFile
+#   undef TclpCreatePipe
+#	undef TclpInetNtoa
+#   undef TclUnixWaitForFile
+
+#	define TclpCreateTempFile ((TclFile (*) _ANSI_ARGS_((CONST char *))) \
+		tclIntPlatStubsPtr->tclWinGetPlatformId)
+#	define TclGetAndDetachPids ((void (*) _ANSI_ARGS_((Tcl_Interp *, Tcl_Channel))) \
+	    tclIntPlatStubsPtr->tclWinConvertError)
+#	define TclpCloseFile ((int (*) _ANSI_ARGS_((TclFile))) \
+	    tclIntPlatStubsPtr->tclWinConvertWSAError)
+#   define TclpCreatePipe ((int (*)_ANSI_ARGS_((TclFile *, TclFile *))) \
+	    tclIntPlatStubsPtr->tclWinGetSockOpt)
+#   define TclpInetNtoa ((char *(*) _ANSI_ARGS_((struct in_addr addr))) \
+	    tclIntPlatStubsPtr->tclIntPlatReserved13)
+#   define TclUnixWaitForFile (int (*) _ANSI_ARGS_((int, int, int))) \
+		tclIntPlatStubsPtr->tclpGetPid)
+#   endif
+# endif
 #endif
 
 #endif /* _TCLINTPLATDECLS */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 5b6d14f..53686bd 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1,67 +1,63 @@
-/*
+/* 
  * 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>
+
 /*
- * 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.
+ * Counter for how many aliases were created (global)
  */
 
-static const char *tclPreInitScript = NULL;
-
-/* Forward declaration */
-struct Target;
+static int aliasCounter = 0;
+TCL_DECLARE_MUTEX(cntMutex)
 
 /*
  * 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 *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_Obj *namePtr;		/* Name of alias command in slave interp. */
     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. */
-    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. */
+                                 * 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. */
 } Alias;
 
 /*
@@ -69,23 +65,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;
 
 /*
@@ -96,47 +92,43 @@ 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 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.
+ * 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.
  */
 
 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 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.
+ * 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.
  */
 
 typedef struct Master {
-    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. */
+    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. */
 } Master;
 
 /*
@@ -152,271 +144,67 @@ typedef struct InterpInfo {
 } InterpInfo;
 
 /*
- * 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.
+ * Prototypes for local static procedures:
  */
 
-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(Tcl_Interp *interp,
+static int		AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
 			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
-			    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 int		AliasNRCmd(ClientData dummy,
+			    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_Interp *currentInterp, int objc,
-			    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_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_Interp *slaveInterp, int objc,
-			    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_Obj *CONST objv[]));
+static int		SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int objc,
-			    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_Obj *CONST objv[]));
+static int		SlaveHide _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int objc,
-			    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.
- *
- *----------------------------------------------------------------------
- */
-
-const char *
-TclSetPreInitScript(
-    const char *string)		/* Pointer to a script. */
-{
-    const 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().
-     */
+			    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[]));
 
-    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.
@@ -429,19 +217,19 @@ Tcl_Init(
  */
 
 int
-TclInterpInit(
-    Tcl_Interp *interp)		/* Interpreter to initialize. */
+TclInterpInit(interp)
+    Tcl_Interp *interp;			/* Interpreter to initialize. */
 {
     InterpInfo *interpInfoPtr;
     Master *masterPtr;
-    Slave *slavePtr;
+    Slave *slavePtr;	
 
-    interpInfoPtr = ckalloc(sizeof(InterpInfo));
-    ((Interp *) interp)->interpInfo = interpInfoPtr;
+    interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
+    ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;
 
     masterPtr = &interpInfoPtr->master;
     Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
-    masterPtr->targetsPtr = NULL;
+    Tcl_InitHashTable(&masterPtr->targetTable, TCL_ONE_WORD_KEYS);
 
     slavePtr = &interpInfoPtr->slave;
     slavePtr->masterInterp	= NULL;
@@ -461,27 +249,30 @@ TclInterpInit(
  *
  * 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 clientData,	/* Ignored. */
-    Tcl_Interp *interp)		/* Interp being deleted. All commands for
+InterpInfoDeleteProc(clientData, interp)
+    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;
@@ -492,34 +283,36 @@ InterpInfoDeleteProc(
 
     masterPtr = &interpInfoPtr->master;
     if (masterPtr->slaveTable.numEntries != 0) {
-	Tcl_Panic("InterpInfoDeleteProc: still exist commands");
+	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. 
      */
 
-    for (targetPtr = masterPtr->targetsPtr; targetPtr != NULL; ) {
-	Target *tmpPtr = targetPtr->nextPtr;
+    hPtr = Tcl_FirstHashEntry(&masterPtr->targetTable, &hSearch);
+    while (hPtr != NULL) {
+	targetPtr = (Target *) Tcl_GetHashValue(hPtr);
 	Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
 		targetPtr->slaveCmd);
-	targetPtr = tmpPtr;
+	hPtr = Tcl_NextHashEntry(&hSearch);
     }
+    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);
     }
 
@@ -528,11 +321,11 @@ InterpInfoDeleteProc(
      */
 
     if (slavePtr->aliasTable.numEntries != 0) {
-	Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
+	panic("InterpInfoDeleteProc: still exist aliases");
     }
     Tcl_DeleteHashTable(&slavePtr->aliasTable);
 
-    ckfree(interpInfoPtr);
+    ckfree((char *) interpInfoPtr);    
 }
 
 /*
@@ -540,8 +333,8 @@ InterpInfoDeleteProc(
  *
  * Tcl_InterpObjCmd --
  *
- *	This function is invoked to process the "interp" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "interp" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -553,514 +346,430 @@ InterpInfoDeleteProc(
  */
 	/* ARGSUSED */
 int
-Tcl_InterpObjCmd(
-    ClientData clientData,		/* Unused. */
-    Tcl_Interp *interp,			/* Current interpreter. */
-    int objc,				/* Number of arguments. */
-    Tcl_Obj *const objv[])		/* Argument objects. */
+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_Interp *slaveInterp;
     int index;
-    static const char *const options[] = {
-	"alias",	"aliases",	"bgerror",	"cancel",
-	"create",	"debug",	"delete",
-	"eval",		"exists",	"expose",
-	"hide",		"hidden",	"issafe",
-	"invokehidden",	"limit",	"marktrusted",	"recursionlimit",
-	"slaves",	"share",	"target",	"transfer",
-	NULL
+    static CONST char *options[] = {
+        "alias",	"aliases",	"create",	"delete", 
+	"eval",		"exists",	"expose",	"hide", 
+	"hidden",	"issafe",	"invokehidden",	"marktrusted", 
+	"recursionlimit",		"slaves",	"share",
+	"target",	"transfer",
+        NULL
     };
     enum option {
-	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CANCEL,
-	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
+	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
     };
 
+
     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 *masterInterp;
+	case OPT_ALIAS: {
+	    Tcl_Interp *slaveInterp, *masterInterp;
 
-	if (objc < 4) {
-	aliasArgs:
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "slavePath slaveCmd ?masterPath masterCmd? ?arg ...?");
-	    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) {
+	    if (objc < 4) {
+		aliasArgs:
+		Tcl_WrongNumArgs(interp, 2, objv,
+			"slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
 		return TCL_ERROR;
 	    }
-	    if (TclGetString(objv[5])[0] == '\0') {
-		if (objc == 6) {
-		    return AliasDelete(interp, slaveInterp, objv[3]);
+	    slaveInterp = GetInterp(interp, objv[2]);
+	    if (slaveInterp == (Tcl_Interp *) 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);
 		}
-	    } else {
-		return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
-			objv[5], objc - 6, objv + 6);
 	    }
+	    goto aliasArgs;
 	}
-	goto aliasArgs;
-    }
-    case OPT_ALIASES:
-	slaveInterp = GetInterp2(interp, objc, objv);
-	if (slaveInterp == NULL) {
-	    return TCL_ERROR;
-	}
-	return AliasList(interp, slaveInterp);
-    case OPT_BGERROR:
-	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_CANCEL: {
-	int i, flags;
-	Tcl_Obj *resultObjPtr;
-	static const char *const cancelOptions[] = {
-	    "-unwind",	"--",	NULL
-	};
-	enum option {
-	    OPT_UNWIND,	OPT_LAST
-	};
-
-	flags = 0;
-
-	for (i = 2; i < objc; i++) {
-	    if (TclGetString(objv[i])[0] != '-') {
-		break;
-	    }
-	    if (Tcl_GetIndexFromObj(interp, objv[i], cancelOptions, "option",
-		    0, &index) != TCL_OK) {
+	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.
+	     */
 
-	    switch ((enum option) index) {
-	    case OPT_UNWIND:
+	    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?");
+		    return TCL_ERROR;
+		}
+		if (i < objc) {
+		    slavePtr = objv[i];
+		}
+	    }
+	    buf[0] = '\0';
+	    if (slavePtr == NULL) {
 		/*
-		 * The evaluation stack in the target interp is to be unwound.
+		 * 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.
 		 */
-
-		flags |= TCL_CANCEL_UNWIND;
-		break;
-	    case OPT_LAST:
-		i++;
-		goto endOfForLoop;
+		
+		for (i = 0; ; i++) {
+		    Tcl_CmdInfo cmdInfo;
+		    
+		    sprintf(buf, "interp%d", i);
+		    if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
+			break;
+		    }
+		}
+		slavePtr = Tcl_NewStringObj(buf, -1);
 	    }
+	    if (SlaveCreate(interp, slavePtr, safe) == NULL) {
+		if (buf[0] != '\0') {
+		    Tcl_DecrRefCount(slavePtr);
+		}
+		return TCL_ERROR;
+	    }
+	    Tcl_SetObjResult(interp, slavePtr);
+	    return TCL_OK;
 	}
-
-    endOfForLoop:
-	if ((i + 2) < objc) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "?-unwind? ?--? ?path? ?result?");
-	    return TCL_ERROR;
+	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);
+	    }
+	    return TCL_OK;
 	}
+	case OPT_EVAL: {
+	    Tcl_Interp *slaveInterp;
 
-	/*
-	 * Did they specify a slave interp to cancel the script in progress
-	 * in?  If not, use the current interp.
-	 */
-
-	if (i < objc) {
-	    slaveInterp = GetInterp(interp, objv[i]);
+	    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;
 	    }
-	    i++;
-	} else {
-	    slaveInterp = interp;
+	    return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
 	}
+	case OPT_EXISTS: {
+	    int exists;
+	    Tcl_Interp *slaveInterp;
 
-	if (i < objc) {
-	    resultObjPtr = objv[i];
-
-	    /*
-	     * Tcl_CancelEval removes this reference.
-	     */
+	    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;
+	}
+	case OPT_EXPOSE: {
+	    Tcl_Interp *slaveInterp;
 
-	    Tcl_IncrRefCount(resultObjPtr);
-	    i++;
-	} else {
-	    resultObjPtr = NULL;
+	    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;
+	    }
+	    return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
 	}
+	case OPT_HIDE: {
+	    Tcl_Interp *slaveInterp;		/* A slave. */
 
-	return Tcl_CancelEval(slaveInterp, resultObjPtr, 0, flags);
-    }
-    case OPT_CREATE: {
-	int i, last, safe;
-	Tcl_Obj *slavePtr;
-	char buf[16 + TCL_INTEGER_SPACE];
-	static const char *const createOptions[] = {
-	    "-safe",	"--", NULL
-	};
-	enum option {
-	    OPT_SAFE,	OPT_LAST
-	};
-
-	safe = Tcl_IsSafe(interp);
+	    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) {
+		return TCL_ERROR;
+	    }
+	    return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
+	}
+	case OPT_HIDDEN: {
+	    Tcl_Interp *slaveInterp;		/* A slave. */
 
-	/*
-	 * Weird historical rules: "-safe" is accepted at the end, too.
-	 */
+	    slaveInterp = GetInterp2(interp, objc, objv);
+	    if (slaveInterp == NULL) {
+		return TCL_ERROR;
+	    }
+	    return SlaveHidden(interp, slaveInterp);
+	}
+	case OPT_ISSAFE: {
+	    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], createOptions,
+	    slaveInterp = GetInterp2(interp, objc, objv);
+	    if (slaveInterp == NULL) {
+		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] != '-') {
+		    break;
+		}
+		if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
 			"option", 0, &index) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		if (index == OPT_SAFE) {
-		    safe = 1;
-		    continue;
+		if (index == OPT_GLOBAL) {
+		    global = 1;
+		} else {
+		    i++;
+		    break;
 		}
-		i++;
-		last = 1;
 	    }
-	    if (slavePtr != NULL) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
+	    if (objc - i < 1) {
+		Tcl_WrongNumArgs(interp, 2, objv,
+			"path ?-global? ?--? cmd ?arg ..?");
 		return TCL_ERROR;
 	    }
-	    if (i < objc) {
-		slavePtr = objv[i];
+	    slaveInterp = GetInterp(interp, objv[2]);
+	    if (slaveInterp == (Tcl_Interp *) NULL) {
+		return TCL_ERROR;
 	    }
+	    return SlaveInvokeHidden(interp, slaveInterp, global, objc - i,
+		    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;
+	case OPT_MARKTRUSTED: {
+	    Tcl_Interp *slaveInterp;
 
-		sprintf(buf, "interp%d", i);
-		if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
-		    break;
-		}
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "path");
+		return TCL_ERROR;
 	    }
-	    slavePtr = Tcl_NewStringObj(buf, -1);
-	}
-	if (SlaveCreate(interp, slavePtr, safe) == NULL) {
-	    if (buf[0] != '\0') {
-		Tcl_DecrRefCount(slavePtr);
+	    slaveInterp = GetInterp(interp, objv[2]);
+	    if (slaveInterp == NULL) {
+		return TCL_ERROR;
 	    }
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, slavePtr);
-	return TCL_OK;
-    }
-    case OPT_DEBUG:		/* TIP #378 */
-	/*
-	 * 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;
+	    return SlaveMarkTrusted(interp, slaveInterp);
 	}
-	return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
-    case OPT_DELETE: {
-	int i;
-	InterpInfo *iiPtr;
+	case OPT_RECLIMIT: {
+	    Tcl_Interp *slaveInterp;
 
-	for (i = 2; i < objc; i++) {
-	    slaveInterp = GetInterp(interp, objv[i]);
+	    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;
-	    } else if (slaveInterp == interp) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"cannot delete the current interpreter", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			"DELETESELF", NULL);
+	    }
+	    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;
-	    Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,
-		    iiPtr->slave.interpCmd);
-	}
-	return TCL_OK;
-    }
-    case OPT_EVAL:
-	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;
+	    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;
 	}
-	return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
-    case OPT_EXISTS: {
-	int exists = 1;
+	case OPT_SHARE: {
+	    Tcl_Interp *slaveInterp;		/* A slave. */
+	    Tcl_Interp *masterInterp;		/* Its master. */
+	    Tcl_Channel chan;
 
-	slaveInterp = GetInterp2(interp, objc, objv);
-	if (slaveInterp == NULL) {
-	    if (objc > 3) {
+	    if (objc != 5) {
+		Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
 		return TCL_ERROR;
 	    }
-	    Tcl_ResetResult(interp);
-	    exists = 0;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
-	return TCL_OK;
-    }
-    case OPT_EXPOSE:
-	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;
-	}
-	return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
-    case OPT_HIDE:
-	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:
-	slaveInterp = GetInterp2(interp, objc, objv);
-	if (slaveInterp == NULL) {
-	    return TCL_ERROR;
-	}
-	return SlaveHidden(interp, slaveInterp);
-    case OPT_ISSAFE:
-	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;
-	const char *namespaceName;
-	static const char *const 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;
+	    masterInterp = GetInterp(interp, objv[2]);
+	    if (masterInterp == NULL) {
+		return TCL_ERROR;
 	    }
-	    if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option",
-		    0, &index) != TCL_OK) {
+	    chan = Tcl_GetChannel(masterInterp, Tcl_GetString(objv[3]),
+		    NULL);
+	    if (chan == NULL) {
+		TclTransferResult(masterInterp, TCL_OK, interp);
 		return TCL_ERROR;
 	    }
-	    if (index == OPT_GLOBAL) {
-		namespaceName = "::";
-	    } else if (index == OPT_NAMESPACE) {
-		if (++i == objc) { /* There must be more arguments. */
-		    break;
-		} else {
-		    namespaceName = TclGetString(objv[i]);
-		}
-	    } else {
-		i++;
-		break;
+	    slaveInterp = GetInterp(interp, objv[4]);
+	    if (slaveInterp == NULL) {
+		return TCL_ERROR;
 	    }
+	    Tcl_RegisterChannel(slaveInterp, chan);
+	    return TCL_OK;
 	}
-	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: {
-	static const char *const limitTypes[] = {
-	    "commands", "time", NULL
-	};
-	enum LimitTypes {
-	    LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME
-	};
-	int limitType;
-
-	if (objc < 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "path limitType ?-option value ...?");
-	    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:
-	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);
-    case OPT_RECLIMIT:
-	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: {
-	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_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));
-	}
-	Tcl_SetObjResult(interp, resultPtr);
-	return TCL_OK;
-    }
-    case OPT_TRANSFER:
-    case OPT_SHARE: {
-	Tcl_Interp *masterInterp;	/* The master of the slave. */
-	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) {
-	    Tcl_TransferResult(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.
-	     */
+	case OPT_TARGET: {
+	    Tcl_Interp *slaveInterp;
+	    InterpInfo *iiPtr;
+	    Tcl_HashEntry *hPtr;	
+	    Alias *aliasPtr;		
+	    char *aliasName;
 
-	    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
-		Tcl_TransferResult(masterInterp, TCL_OK, interp);
+	    if (objc != 4) {
+		Tcl_WrongNumArgs(interp, 2, objv, "path alias");
 		return TCL_ERROR;
 	    }
-	}
-	return TCL_OK;
-    }
-    case OPT_TARGET: {
-	InterpInfo *iiPtr;
-	Tcl_HashEntry *hPtr;
-	Alias *aliasPtr;
-	const 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 = TclGetString(objv[3]);
+	    aliasName = Tcl_GetString(objv[3]);
 
-	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;
+	    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;
 	}
-	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);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-		    "TARGETSHROUDED", 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;
 	}
-	return TCL_OK;
-    }
     }
     return TCL_OK;
 }
@@ -1074,24 +783,24 @@ Tcl_InterpObjCmd(
  *	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(
-    Tcl_Interp *interp,		/* Default interp if no interp was specified
+GetInterp2(interp, objc, objv)
+    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;
@@ -1120,25 +829,25 @@ GetInterp2(
  */
 
 int
-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_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_Obj *slaveObjPtr, *targetObjPtr;
     Tcl_Obj **objv;
     int i;
     int result;
-
-    objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
+    
+    objv = (Tcl_Obj **) ckalloc((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);
 
@@ -1151,7 +860,7 @@ Tcl_CreateAlias(
     for (i = 0; i < argc; i++) {
 	Tcl_DecrRefCount(objv[i]);
     }
-    TclStackFree(slaveInterp, objv);
+    ckfree((char *) objv);
     Tcl_DecrRefCount(targetObjPtr);
     Tcl_DecrRefCount(slaveObjPtr);
 
@@ -1175,13 +884,13 @@ Tcl_CreateAlias(
  */
 
 int
-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_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_Obj *slaveObjPtr, *targetObjPtr;
     int result;
@@ -1208,7 +917,7 @@ Tcl_CreateAliasObj(
  *	Gets information about an alias.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl result. 
  *
  * Side effects:
  *	None.
@@ -1217,28 +926,29 @@ Tcl_CreateAliasObj(
  */
 
 int
-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. */
+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. */
 {
-    InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
+    InterpInfo *iiPtr;
     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_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "alias \"", aliasName, "\" not found", (char *) NULL);
 	return TCL_ERROR;
     }
-    aliasPtr = Tcl_GetHashValue(hPtr);
+    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
     objc = aliasPtr->objc;
     objv = &aliasPtr->objPtr;
 
@@ -1246,17 +956,17 @@ Tcl_GetAlias(
 	*targetInterpPtr = aliasPtr->targetInterp;
     }
     if (targetNamePtr != NULL) {
-	*targetNamePtr = TclGetString(objv[0]);
+	*targetNamePtr = Tcl_GetString(objv[0]);
     }
     if (argcPtr != NULL) {
 	*argcPtr = objc - 1;
     }
     if (argvPtr != NULL) {
-	*argvPtr = (const char **)
-		ckalloc(sizeof(const char *) * (objc - 1));
-	for (i = 1; i < objc; i++) {
-	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
-	}
+        *argvPtr = (CONST char **) 
+		ckalloc((unsigned) sizeof(CONST char *) * (objc - 1));
+        for (i = 1; i < objc; i++) {
+            (*argvPtr)[i - 1] = Tcl_GetString(objv[i]);
+        }
     }
     return TCL_OK;
 }
@@ -1278,42 +988,43 @@ Tcl_GetAlias(
  */
 
 int
-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. */
+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. */
 {
-    InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
+    InterpInfo *iiPtr;
     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 == NULL) {
-	Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
-	return TCL_ERROR;
+    if (hPtr == (Tcl_HashEntry *) NULL) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "alias \"", aliasName, "\" not found", (char *) NULL);
+        return TCL_ERROR;
     }
-    aliasPtr = Tcl_GetHashValue(hPtr);
+    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
     objc = aliasPtr->objc;
     objv = &aliasPtr->objPtr;
 
-    if (targetInterpPtr != NULL) {
-	*targetInterpPtr = aliasPtr->targetInterp;
+    if (targetInterpPtr != (Tcl_Interp **) NULL) {
+        *targetInterpPtr = aliasPtr->targetInterp;
     }
-    if (targetNamePtr != NULL) {
-	*targetNamePtr = TclGetString(objv[0]);
+    if (targetNamePtr != (CONST char **) NULL) {
+        *targetNamePtr = Tcl_GetString(objv[0]);
     }
-    if (objcPtr != NULL) {
-	*objcPtr = objc - 1;
+    if (objcPtr != (int *) NULL) {
+        *objcPtr = objc - 1;
     }
-    if (objvPtr != NULL) {
-	*objvPtr = objv + 1;
+    if (objvPtr != (Tcl_Obj ***) NULL) {
+        *objvPtr = objv + 1;
     }
     return TCL_OK;
 }
@@ -1323,29 +1034,30 @@ Tcl_GetAliasObj(
  *
  * 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(
-    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(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. */
 {
     Command *cmdPtr = (Command *) cmd;
     Alias *aliasPtr, *nextAliasPtr;
@@ -1353,28 +1065,28 @@ TclPreventAliasLoop(
     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 = cmdPtr->objClientData;
+    aliasPtr = (Alias *) cmdPtr->objClientData;
     nextAliasPtr = aliasPtr;
     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)) {
@@ -1383,39 +1095,39 @@ TclPreventAliasLoop(
 	     * [Bug #641195]
 	     */
 
-	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
-		    Tcl_GetCommandName(cmdInterp, cmd),
-		    "\": interpreter deleted", NULL);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "cannot define or rename alias \"",
+		    Tcl_GetString(aliasPtr->namePtr),
+		    "\": interpreter deleted", (char *) NULL);
 	    return TCL_ERROR;
 	}
 	cmdNamePtr = nextAliasPtr->objPtr;
 	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
-		TclGetString(cmdNamePtr),
+                Tcl_GetString(cmdNamePtr),
 		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
 		/*flags*/ 0);
-	if (aliasCmd == NULL) {
-	    return TCL_OK;
-	}
+        if (aliasCmd == (Tcl_Command) NULL) {
+            return TCL_OK;
+        }
 	aliasCmdPtr = (Command *) aliasCmd;
-	if (aliasCmdPtr == cmdPtr) {
-	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
-		    Tcl_GetCommandName(cmdInterp, cmd),
-		    "\": would create a loop", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-		    "ALIASLOOP", NULL);
-	    return TCL_ERROR;
-	}
-
-	/*
+        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;
+        }
+
+        /*
 	 * 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 = aliasCmdPtr->objClientData;
+        if (aliasCmdPtr->objProc != AliasObjCmd) {
+            return TCL_OK;
+        }
+        nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
     }
 
     /* NOTREACHED */
@@ -1432,23 +1144,24 @@ TclPreventAliasLoop(
  *	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(
-    Tcl_Interp *interp,		/* Interp for error reporting. */
-    Tcl_Interp *slaveInterp,	/* Interp where alias cmd will live or from
+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
 				 * 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;
@@ -1456,12 +1169,13 @@ AliasCreate(
     Slave *slavePtr;
     Master *masterPtr;
     Tcl_Obj **prefv;
-    int isNew, i;
+    int new, i;
 
-    aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
-    aliasPtr->token = namePtr;
-    Tcl_IncrRefCount(aliasPtr->token);
-    aliasPtr->targetInterp = masterInterp;
+    aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias) 
+            + objc * sizeof(Tcl_Obj *)));
+    aliasPtr->namePtr		= namePtr;
+    Tcl_IncrRefCount(aliasPtr->namePtr);
+    aliasPtr->targetInterp	= masterInterp;
 
     aliasPtr->objc = objc + 1;
     prefv = &aliasPtr->objPtr;
@@ -1476,40 +1190,34 @@ AliasCreate(
     Tcl_Preserve(slaveInterp);
     Tcl_Preserve(masterInterp);
 
-    if (slaveInterp == masterInterp) {
-	aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
-		TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
-		AliasObjCmdDeleteProc);
-    } else {
     aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
-	    TclGetString(namePtr), AliasObjCmd, aliasPtr,
+	    Tcl_GetString(namePtr), AliasObjCmd, (ClientData) 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->token);
+	
+	Tcl_DecrRefCount(aliasPtr->namePtr);
 	Tcl_DecrRefCount(targetNamePtr);
 	for (i = 0; i < objc; i++) {
 	    Tcl_DecrRefCount(objv[i]);
 	}
-
+	
 	cmdPtr = (Command *) aliasPtr->slaveCmd;
 	cmdPtr->clientData = NULL;
 	cmdPtr->deleteProc = NULL;
 	cmdPtr->deleteData = NULL;
 	Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
 
-	ckfree(aliasPtr);
+	ckfree((char *) aliasPtr);
 
 	/*
 	 * The result was already set by TclPreventAliasLoop.
@@ -1521,42 +1229,28 @@ AliasCreate(
     }
 
     /*
-     * Make an entry in the alias table. If it already exists, retry.
+     * Make an entry in the alias table. If it already exists delete
+     * the alias command. Then retry.
      */
 
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
     while (1) {
-	Tcl_Obj *newToken;
-	const char *string;
-
-	string = TclGetString(aliasPtr->token);
-	hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
-	if (isNew != 0) {
+	Alias *oldAliasPtr;
+	char *string;
+	
+	string = Tcl_GetString(namePtr);
+	hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new);
+	if (new != 0) {
 	    break;
 	}
 
-	/*
-	 * 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);
+	oldAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
+	Tcl_DeleteCommandFromToken(slaveInterp, oldAliasPtr->slaveCmd);
     }
 
     aliasPtr->aliasEntryPtr = hPtr;
-    Tcl_SetHashValue(hPtr, aliasPtr);
-
+    Tcl_SetHashValue(hPtr, (ClientData) 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:
@@ -1566,20 +1260,23 @@ AliasCreate(
      * interp alias {} foo {} zop		# Now recreate "foo"...
      */
 
-    targetPtr = ckalloc(sizeof(Target));
+    targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
     targetPtr->slaveCmd = aliasPtr->slaveCmd;
     targetPtr->slaveInterp = slaveInterp;
 
-    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_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;
 
-    Tcl_SetObjResult(interp, aliasPtr->token);
+    Tcl_SetObjResult(interp, namePtr);
 
     Tcl_Release(slaveInterp);
     Tcl_Release(masterInterp);
@@ -1603,10 +1300,10 @@ AliasCreate(
  */
 
 static int
-AliasDelete(
-    Tcl_Interp *interp,		/* Interpreter for result & errors. */
-    Tcl_Interp *slaveInterp,	/* Interpreter containing alias. */
-    Tcl_Obj *namePtr)		/* Name of alias to delete. */
+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. */
 {
     Slave *slavePtr;
     Alias *aliasPtr;
@@ -1619,15 +1316,13 @@ AliasDelete(
      */
 
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
-    hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
+    hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
     if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr),
-		"\" not found", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
-		TclGetString(namePtr), NULL);
-	return TCL_ERROR;
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "alias \"",
+		Tcl_GetString(namePtr), "\" not found", NULL);
+        return TCL_ERROR;
     }
-    aliasPtr = Tcl_GetHashValue(hPtr);
+    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
     Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
     return TCL_OK;
 }
@@ -1637,9 +1332,10 @@ AliasDelete(
  *
  * 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.
@@ -1651,14 +1347,14 @@ AliasDelete(
  */
 
 static int
-AliasDescribe(
-    Tcl_Interp *interp,		/* Interpreter for result & errors. */
-    Tcl_Interp *slaveInterp,	/* Interpreter containing alias. */
-    Tcl_Obj *namePtr)		/* Name of alias to describe. */
+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. */
 {
     Slave *slavePtr;
     Tcl_HashEntry *hPtr;
-    Alias *aliasPtr;
+    Alias *aliasPtr;	
     Tcl_Obj *prefixPtr;
 
     /*
@@ -1670,9 +1366,9 @@ AliasDescribe(
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
     hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
     if (hPtr == NULL) {
-	return TCL_OK;
+        return TCL_OK;
     }
-    aliasPtr = Tcl_GetHashValue(hPtr);
+    aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
     prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
     Tcl_SetObjResult(interp, prefixPtr);
     return TCL_OK;
@@ -1695,24 +1391,24 @@ AliasDescribe(
  */
 
 static int
-AliasList(
-    Tcl_Interp *interp,		/* Interp for data return. */
-    Tcl_Interp *slaveInterp)	/* Interp whose aliases to compute. */
+AliasList(interp, slaveInterp)
+    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_NewObj();
+    Tcl_Obj *resultPtr;	
     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 = Tcl_GetHashValue(entryPtr);
-	Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token);
+        aliasPtr = (Alias *) Tcl_GetHashValue(entryPtr);
+        Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->namePtr);
     }
-    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
@@ -1721,184 +1417,80 @@ AliasList(
  *
  * AliasObjCmd --
  *
- *	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.
+ *	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.
  *
  * 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
-AliasNRCmd(
-    ClientData clientData,	/* Alias record. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument vector. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Alias *aliasPtr = clientData;
-    int prefc, cmdc, i;
-    Tcl_Obj **prefv, **cmdv;
-    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-    Tcl_Obj *listPtr;
-    List *listRep;
-    int flags = TCL_EVAL_INVOKE;
-
-    /*
-     * 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;
-
-    listPtr = Tcl_NewListObj(cmdc, NULL);
-    listRep = listPtr->internalRep.twoPtrValue.ptr1;
-    listRep->elemCount = cmdc;
-    cmdv = &listRep->elements;
-
-    prefv = &aliasPtr->objPtr;
-    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
-    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
-
-    for (i=0; i<cmdc; i++) {
-	Tcl_IncrRefCount(cmdv[i]);
-    }
-
-    /*
-     * Use the ensemble rewriting machinery to ensure correct error messages:
-     * only the source command should show, not the full target prefix.
-     */
-
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = objv;
-	iPtr->ensembleRewrite.numRemovedObjs = 1;
-	iPtr->ensembleRewrite.numInsertedObjs = prefc;
-    } else {
-	iPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
-    }
-
-    /*
-     * We are sending a 0-refCount obj, do not need a callback: it will be
-     * cleaned up automatically. But we may need to clear the rootEnsemble
-     * stuff ...
-     */
-
-    if (isRootEnsemble) {
-	TclNRDeferCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
-    }
-    iPtr->evalFlags |= TCL_EVAL_REDIRECT;
-    return Tcl_NREvalObj(interp, listPtr, flags);
-}
-
-static int
-AliasObjCmd(
-    ClientData clientData,	/* Alias record. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument vector. */
+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. */	
 {
 #define ALIAS_CMDV_PREALLOC 10
-    Alias *aliasPtr = clientData;
-    Tcl_Interp *targetInterp = aliasPtr->targetInterp;
+    Tcl_Interp *targetInterp;	
+    Alias *aliasPtr;		
     int result, prefc, cmdc, i;
     Tcl_Obj **prefv, **cmdv;
     Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
-    Interp *tPtr = (Interp *) targetInterp;
-    int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);
+    aliasPtr = (Alias *) clientData;
+    targetInterp = aliasPtr->targetInterp;
 
     /*
-     * 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 = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
+	cmdv = (Tcl_Obj **) ckalloc((unsigned) (cmdc * sizeof(Tcl_Obj *)));
     }
 
     prefv = &aliasPtr->objPtr;
-    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
-    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+    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 *)));
 
     Tcl_ResetResult(targetInterp);
 
     for (i=0; i<cmdc; i++) {
 	Tcl_IncrRefCount(cmdv[i]);
     }
-
-    /*
-     * 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 {
-	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) {
-	Tcl_TransferResult(targetInterp, result, interp);
-	Tcl_Release(targetInterp);
+	Tcl_Preserve((ClientData) targetInterp);
+	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
+	TclTransferResult(targetInterp, result, interp);	
+	Tcl_Release((ClientData) targetInterp);
+    } else {
+	result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);
     }
-
     for (i=0; i<cmdc; i++) {
 	Tcl_DecrRefCount(cmdv[i]);
     }
+
     if (cmdv != cmdArr) {
-	TclStackFree(interp, cmdv);
+	ckfree((char *) cmdv);
     }
-    return result;
+    return result;        
 #undef ALIAS_CMDV_PREALLOC
 }
 
@@ -1907,54 +1499,42 @@ AliasObjCmd(
  *
  * 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)	/* The alias record for this alias. */
+AliasObjCmdDeleteProc(clientData)
+    ClientData clientData;	/* The alias record for this alias. */
 {
-    Alias *aliasPtr = clientData;
-    Target *targetPtr;
+    Alias *aliasPtr;		
+    Target *targetPtr;		
     int i;
     Tcl_Obj **objv;
 
-    Tcl_DecrRefCount(aliasPtr->token);
+    aliasPtr = (Alias *) clientData;
+    
+    Tcl_DecrRefCount(aliasPtr->namePtr);
     objv = &aliasPtr->objPtr;
     for (i = 0; i < aliasPtr->objc; i++) {
 	Tcl_DecrRefCount(objv[i]);
     }
     Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);
 
-    /*
-     * Splice the target record out of the target interpreter's master list.
-     */
+    targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntryPtr);
+    ckfree((char *) targetPtr);
+    Tcl_DeleteHashEntry(aliasPtr->targetEntryPtr);
 
-    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(targetPtr);
-    ckfree(aliasPtr);
+    ckfree((char *) aliasPtr);
 }
 
 /*
@@ -1962,29 +1542,29 @@ AliasObjCmdDeleteProc(
  *
  * 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(
-    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(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_Obj *pathPtr;
     Tcl_Interp *slaveInterp;
@@ -2004,7 +1584,8 @@ Tcl_CreateSlave(
  *	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.
@@ -2013,9 +1594,9 @@ Tcl_CreateSlave(
  */
 
 Tcl_Interp *
-Tcl_GetSlave(
-    Tcl_Interp *interp,		/* Interpreter to start search from. */
-    const char *slavePath)	/* Path of slave to find. */
+Tcl_GetSlave(interp, slavePath)
+    Tcl_Interp *interp;		/* Interpreter to start search from. */
+    CONST char *slavePath;	/* Path of slave to find. */
 {
     Tcl_Obj *pathPtr;
     Tcl_Interp *slaveInterp;
@@ -2044,13 +1625,13 @@ Tcl_GetSlave(
  */
 
 Tcl_Interp *
-Tcl_GetMaster(
-    Tcl_Interp *interp)		/* Get the master of this interpreter. */
+Tcl_GetMaster(interp)
+    Tcl_Interp *interp;		/* Get the master of this interpreter. */
 {
     Slave *slavePtr;		/* Slave record of this interpreter. */
 
-    if (interp == NULL) {
-	return NULL;
+    if (interp == (Tcl_Interp *) NULL) {
+        return NULL;
     }
     slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
     return slavePtr->masterInterp;
@@ -2059,86 +1640,22 @@ Tcl_GetMaster(
 /*
  *----------------------------------------------------------------------
  *
- * TclSetSlaveCancelFlags --
- *
- *	This function marks all slave interpreters belonging to a given
- *	interpreter as being canceled or not canceled, depending on the
- *	provided flags.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSetSlaveCancelFlags(
-    Tcl_Interp *interp,		/* Set cancel flags of this interpreter. */
-    int flags,			/* Collection of OR-ed bits that control
-				 * the cancellation of the script. Only
-				 * TCL_CANCEL_UNWIND is currently
-				 * supported. */
-    int force)			/* Non-zero to ignore numLevels for the purpose
-				 * of resetting the cancellation flags. */
-{
-    Master *masterPtr;		/* Master record of given interpreter. */
-    Tcl_HashEntry *hPtr;	/* Search element. */
-    Tcl_HashSearch hashSearch;	/* Search variable. */
-    Slave *slavePtr;		/* Slave record of interpreter. */
-    Interp *iPtr;
-
-    if (interp == NULL) {
-	return;
-    }
-
-    flags &= (CANCELED | TCL_CANCEL_UNWIND);
-
-    masterPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->master;
-
-    hPtr = Tcl_FirstHashEntry(&masterPtr->slaveTable, &hashSearch);
-    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
-	slavePtr = Tcl_GetHashValue(hPtr);
-	iPtr = (Interp *) slavePtr->slaveInterp;
-
-	if (iPtr == NULL) {
-	    continue;
-	}
-
-	if (flags == 0) {
-	    TclResetCancellation((Tcl_Interp *) iPtr, force);
-	} else {
-	    TclSetCancelFlags(iPtr, flags);
-	}
-
-	/*
-	 * Now, recursively handle this for the slaves of this slave
-	 * interpreter.
-	 */
-
-	TclSetSlaveCancelFlags((Tcl_Interp *) iPtr, flags, force);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * 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.
@@ -2147,24 +1664,25 @@ TclSetSlaveCancelFlags(
  */
 
 int
-Tcl_GetInterpPath(
-    Tcl_Interp *askingInterp,	/* Interpreter to start search from. */
-    Tcl_Interp *targetInterp)	/* Interpreter to find. */
+Tcl_GetInterpPath(askingInterp, targetInterp)
+    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;
 }
 
@@ -2177,7 +1695,7 @@ Tcl_GetInterpPath(
  *
  * 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.
@@ -2186,42 +1704,41 @@ Tcl_GetInterpPath(
  */
 
 static Tcl_Interp *
-GetInterp(
-    Tcl_Interp *interp,		/* Interp. to start search from. */
-    Tcl_Obj *pathPtr)		/* List object containing name of interp. to
+GetInterp(interp, pathPtr)
+    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 (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+    if (Tcl_ListObjGetElements(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,
-		TclGetString(objv[i]));
-	if (hPtr == NULL) {
+        hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
+		Tcl_GetString(objv[i]));
+        if (hPtr == NULL) {
 	    searchInterp = NULL;
 	    break;
 	}
-	slavePtr = Tcl_GetHashValue(hPtr);
-	searchInterp = slavePtr->slaveInterp;
-	if (searchInterp == NULL) {
+        slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+        searchInterp = slavePtr->slaveInterp;
+        if (searchInterp == NULL) {
 	    break;
 	}
     }
     if (searchInterp == NULL) {
-	Tcl_AppendResult(interp, "could not find interpreter \"",
-		TclGetString(pathPtr), "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
-		TclGetString(pathPtr), NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"could not find interpreter \"",
+                Tcl_GetString(pathPtr), "\"", (char *) NULL);
     }
     return searchInterp;
 }
@@ -2229,53 +1746,11 @@ GetInterp(
 /*
  *----------------------------------------------------------------------
  *
- * 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);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-		    "BGERRORFORMAT", 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,
@@ -2288,17 +1763,17 @@ SlaveBgerror(
  */
 
 static Tcl_Interp *
-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"? */
+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"? */
 {
     Tcl_Interp *masterInterp, *slaveInterp;
     Slave *slavePtr;
     InterpInfo *masterInfoPtr;
     Tcl_HashEntry *hPtr;
-    const char *path;
-    int isNew, objc;
+    char *path;
+    int new, objc;
     Tcl_Obj **objv;
 
     if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
@@ -2306,29 +1781,29 @@ SlaveCreate(
     }
     if (objc < 2) {
 	masterInterp = interp;
-	path = TclGetString(pathPtr);
+	path = Tcl_GetString(pathPtr);
     } else {
 	Tcl_Obj *objPtr;
-
+	
 	objPtr = Tcl_NewListObj(objc - 1, objv);
 	masterInterp = GetInterp(interp, objPtr);
 	Tcl_DecrRefCount(objPtr);
 	if (masterInterp == NULL) {
 	    return NULL;
 	}
-	path = TclGetString(objv[objc - 1]);
+	path = Tcl_GetString(objv[objc - 1]);
     }
     if (safe == 0) {
 	safe = Tcl_IsSafe(masterInterp);
     }
 
     masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
-    hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
-	    &isNew);
-    if (isNew == 0) {
-	Tcl_AppendResult(interp, "interpreter named \"", path,
-		"\" already exists, cannot create", NULL);
-	return NULL;
+    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;
     }
 
     slaveInterp = Tcl_CreateInterp();
@@ -2337,66 +1812,35 @@ SlaveCreate(
     slavePtr->slaveEntryPtr = hPtr;
     slavePtr->slaveInterp = slaveInterp;
     slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
-	    SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc);
+            SlaveObjCmd, (ClientData) slaveInterp, SlaveObjCmdDeleteProc);
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
-    Tcl_SetHashValue(hPtr, slavePtr);
+    Tcl_SetHashValue(hPtr, (ClientData) 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:
-    Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
-  error2:
+    error:
+    TclTransferResult(slaveInterp, TCL_ERROR, interp);
     Tcl_DeleteInterp(slaveInterp);
 
     return NULL;
@@ -2407,8 +1851,8 @@ SlaveCreate(
  *
  * 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.
@@ -2420,34 +1864,33 @@ SlaveCreate(
  */
 
 static int
-SlaveObjCmd(
-    ClientData clientData,	/* Slave interpreter. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    Tcl_Interp *slaveInterp = clientData;
+    Tcl_Interp *slaveInterp;
     int index;
-    static const char *const options[] = {
-	"alias",	"aliases",	"bgerror",	"debug",
-	"eval",		"expose",	"hide",		"hidden",
-	"issafe",	"invokehidden",	"limit",	"marktrusted",
-	"recursionlimit", NULL
+    static CONST char *options[] = {
+        "alias",	"aliases",	"eval",		"expose",
+        "hide",		"hidden",	"issafe",	"invokehidden",
+        "marktrusted",	"recursionlimit", NULL
     };
     enum options {
-	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
+	OPT_ALIAS,	OPT_ALIASES,	OPT_EVAL,	OPT_EXPOSE,
+	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHIDDEN,
+	OPT_MARKTRUSTED, OPT_RECLIMIT
     };
-
+    
+    slaveInterp = (Tcl_Interp *) clientData;
     if (slaveInterp == NULL) {
-	Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
+	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) {
@@ -2455,151 +1898,113 @@ SlaveObjCmd(
     }
 
     switch ((enum options) index) {
-    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]);
+	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);
 		}
-	    } 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;
 	}
-	Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?");
-	return TCL_ERROR;
-    case OPT_ALIASES:
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	return AliasList(interp, slaveInterp);
-    case OPT_BGERROR:
-	if (objc != 2 && objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?cmdPrefix?");
-	    return TCL_ERROR;
-	}
-	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;
-	}
-	return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
-    case OPT_EVAL:
-	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
-	    return TCL_ERROR;
-	}
-	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;
+	case OPT_ALIASES: {
+	    if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    return AliasList(interp, slaveInterp);
 	}
-	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;
+	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 SlaveHide(interp, slaveInterp, objc - 2, objv + 2);
-    case OPT_HIDDEN:
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    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 SlaveHidden(interp, slaveInterp);
-    case OPT_ISSAFE:
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    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);
 	}
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
-	return TCL_OK;
-    case OPT_INVOKEHIDDEN: {
-	int i;
-	const char *namespaceName;
-	static const char *const 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;
+        case OPT_HIDDEN: {
+	    if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, NULL);
+		return TCL_ERROR;
 	    }
-	    if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions, "option",
-		    0, &index) != TCL_OK) {
+            return SlaveHidden(interp, slaveInterp);
+	}
+        case OPT_ISSAFE: {
+	    if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, (char *) NULL);
 		return TCL_ERROR;
 	    }
-	    if (index == OPT_GLOBAL) {
-		namespaceName = "::";
-	    } else if (index == OPT_NAMESPACE) {
-		if (++i == objc) { /* There must be more arguments. */
+	    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] != '-') {
 		    break;
+		}
+		if (Tcl_GetIndexFromObj(interp, objv[i], hiddenOptions,
+			"option", 0, &index) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+		if (index == OPT_GLOBAL) {
+		    global = 1;
 		} else {
-		    namespaceName = TclGetString(objv[i]);
+		    i++;
+		    break;
 		}
-	    } 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);
 	}
-	if (objc - i < 1) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "?-namespace ns? ?-global? ?--? cmd ?arg ..?");
-	    return TCL_ERROR;
-	}
-	return SlaveInvokeHidden(interp, slaveInterp, namespaceName,
-		objc - i, objv + i);
-    }
-    case OPT_LIMIT: {
-	static const char *const limitTypes[] = {
-	    "commands", "time", NULL
-	};
-	enum LimitTypes {
-	    LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME
-	};
-	int limitType;
-
-	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?");
-	    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;
+	case OPT_MARKTRUSTED: {
+	    if (objc != 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, NULL);
+		return TCL_ERROR;
+	    }
+            return SlaveMarkTrusted(interp, slaveInterp);
 	}
-	return SlaveMarkTrusted(interp, slaveInterp);
-    case OPT_RECLIMIT:
-	if (objc != 2 && objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
-	    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 SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
     }
 
     return TCL_ERROR;
@@ -2618,20 +2023,20 @@ SlaveObjCmd(
  *	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)	/* The SlaveRecord for the command. */
+SlaveObjCmdDeleteProc(clientData)
+    ClientData clientData;		/* The SlaveRecord for the command. */
 {
-    Slave *slavePtr;		/* Interim storage for Slave record. */
-    Tcl_Interp *slaveInterp = clientData;
-				/* And for a slave interp. */
+    Slave *slavePtr;			/* Interim storage for Slave record. */
+    Tcl_Interp *slaveInterp;		/* And for a slave interp. */
 
+    slaveInterp = (Tcl_Interp *) clientData;
     slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
 
     /*
@@ -2641,9 +2046,9 @@ SlaveObjCmdDeleteProc(
     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;
@@ -2656,77 +2061,6 @@ SlaveObjCmdDeleteProc(
 /*
  *----------------------------------------------------------------------
  *
- * SlaveDebugCmd -- TIP #378
- *
- *	Helper function to handle 'debug' command in a slave interpreter.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	May modify INTERP_DEBUG_FRAME 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 *const 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.
@@ -2741,49 +2075,39 @@ SlaveDebugCmd(
  */
 
 static int
-SlaveEval(
-    Tcl_Interp *interp,		/* Interp for error return. */
-    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command
+SlaveEval(interp, slaveInterp, objc, objv)
+    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;
-
-    /*
-     * TIP #285: If necessary, reset the cancellation flags for the slave
-     * interpreter now; otherwise, canceling a script in a master interpreter
-     * can result in a situation where a slave interpreter can no longer
-     * evaluate any scripts unless somebody calls the TclResetCancellation
-     * function for that particular Tcl_Interp.
-     */
-
-    TclSetSlaveCancelFlags(slaveInterp, 0, 0);
-
-    Tcl_Preserve(slaveInterp);
+    Tcl_Obj *objPtr;
+    
+    Tcl_Preserve((ClientData) slaveInterp);
     Tcl_AllowExceptions(slaveInterp);
 
     if (objc == 1) {
-	/*
-	 * 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);
-
+#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;
+	CmdFrame* invoker = iPtr->cmdFramePtr;
+	int word          = 0;
+	TclArgumentGet (interp, objv[0], &invoker, &word);
 	result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
+#endif
     } else {
-	Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
+	objPtr = Tcl_ConcatObj(objc, objv);
 	Tcl_IncrRefCount(objPtr);
 	result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
 	Tcl_DecrRefCount(objPtr);
     }
-    Tcl_TransferResult(slaveInterp, result, interp);
+    TclTransferResult(slaveInterp, result, interp);
 
-    Tcl_Release(slaveInterp);
+    Tcl_Release((ClientData) slaveInterp);
     return result;
 }
 
@@ -2798,34 +2122,32 @@ SlaveEval(
  *	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(
-    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. */
-{
-    const char *name;
-
+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. */
+{
+    char *name;
+    
     if (Tcl_IsSafe(interp)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"permission denied: safe interpreter cannot expose commands",
-		-1));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
-		NULL);
+		(char *) NULL);
 	return TCL_ERROR;
     }
 
-    name = TclGetString(objv[(objc == 1) ? 0 : 1]);
-    if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
+    name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
+    if (Tcl_ExposeCommand(slaveInterp, Tcl_GetString(objv[0]),
 	    name) != TCL_OK) {
-	Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+	TclTransferResult(slaveInterp, TCL_ERROR, interp);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -2842,38 +2164,36 @@ SlaveExpose(
  *	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(
-    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(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. */
 {
     Interp *iPtr;
     int limit;
 
     if (objc) {
 	if (Tcl_IsSafe(interp)) {
-	    Tcl_AppendResult(interp, "permission denied: "
-		    "safe interpreters cannot change recursion limit", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
-		    NULL);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "permission denied: ",
+		    "safe interpreters cannot change recursion limit",
+		    (char *) NULL);
 	    return TCL_ERROR;
 	}
-	if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
+	if (Tcl_GetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
 	    return TCL_ERROR;
 	}
 	if (limit <= 0) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "recursion limit must be > 0", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT",
-		    NULL);
 	    return TCL_ERROR;
 	}
 	Tcl_SetRecursionLimit(slaveInterp, limit);
@@ -2881,15 +2201,14 @@ SlaveRecursionLimit(
 	if (interp == slaveInterp && iPtr->numLevels > limit) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "falling back due to new recursion limit", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
 	    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;
     }
 }
 
@@ -2904,33 +2223,32 @@ SlaveRecursionLimit(
  *	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(
-    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. */
-{
-    const char *name;
-
+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. */
+{
+    char *name;
+    
     if (Tcl_IsSafe(interp)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"permission denied: safe interpreter cannot hide commands",
-		-1));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
-		NULL);
+		(char *) NULL);
 	return TCL_ERROR;
     }
 
-    name = TclGetString(objv[(objc == 1) ? 0 : 1]);
-    if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
-	Tcl_TransferResult(slaveInterp, TCL_ERROR, interp);
+    name = Tcl_GetString(objv[(objc == 1) ? 0 : 1]);
+    if (Tcl_HideCommand(slaveInterp, Tcl_GetString(objv[0]),
+	    name) != TCL_OK) {
+	TclTransferResult(slaveInterp, TCL_ERROR, interp);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -2954,25 +2272,26 @@ SlaveHide(
  */
 
 static int
-SlaveHidden(
-    Tcl_Interp *interp,		/* Interp for data return. */
-    Tcl_Interp *slaveInterp)	/* Interp whose hidden commands to query. */
+SlaveHidden(interp, slaveInterp)
+    Tcl_Interp *interp;		/* Interp for data return. */
+    Tcl_Interp *slaveInterp;	/* Interp whose hidden commands to query. */
 {
-    Tcl_Obj *listObjPtr = Tcl_NewObj();	/* Local object pointer. */
+    Tcl_Obj *listObjPtr;		/* 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 != NULL) {
+    if (hTblPtr != (Tcl_HashTable *) NULL) {
 	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-		hPtr != NULL;
-		hPtr = Tcl_NextHashEntry(&hSearch)) {
+	     hPtr != (Tcl_HashEntry *) NULL;
+	     hPtr = Tcl_NextHashEntry(&hSearch)) {
+
 	    Tcl_ListObjAppendElement(NULL, listObjPtr,
 		    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
 	}
     }
-    Tcl_SetObjResult(interp, listObjPtr);
     return TCL_OK;
 }
 
@@ -2993,47 +2312,37 @@ SlaveHidden(
  */
 
 static int
-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. */
+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. */
 {
     int result;
-
+    
     if (Tcl_IsSafe(interp)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	Tcl_SetStringObj(Tcl_GetObjResult(interp),
 		"not allowed to invoke hidden commands from safe interpreter",
-		-1));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
-		NULL);
+		-1);
 	return TCL_ERROR;
     }
 
-    Tcl_Preserve(slaveInterp);
+    Tcl_Preserve((ClientData) slaveInterp);
     Tcl_AllowExceptions(slaveInterp);
-
-    if (namespaceName == NULL) {
-	result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
+    
+    if (global) {
+        result = TclObjInvokeGlobal(slaveInterp, objc, objv,
+                TCL_INVOKE_HIDDEN);
     } else {
-	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);
-	}
+        result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
     }
 
-    Tcl_TransferResult(slaveInterp, result, interp);
+    TclTransferResult(slaveInterp, result, interp);
 
-    Tcl_Release(slaveInterp);
-    return result;
+    Tcl_Release((ClientData) slaveInterp);
+    return result;        
 }
 
 /*
@@ -3047,24 +2356,22 @@ SlaveInvokeHidden(
  *	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(
-    Tcl_Interp *interp,		/* Interp for error return. */
-    Tcl_Interp *slaveInterp)	/* The slave interpreter which will be marked
-				 * trusted. */
+SlaveMarkTrusted(interp, slaveInterp)
+    Tcl_Interp *interp;		/* Interp for error return. */
+    Tcl_Interp *slaveInterp;	/* The slave interpreter which will be
+				 * marked trusted. */
 {
     if (Tcl_IsSafe(interp)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"permission denied: safe interpreter cannot mark trusted",
-		-1));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
-		NULL);
+		(char *) NULL);
 	return TCL_ERROR;
     }
     ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
@@ -3088,15 +2395,17 @@ SlaveMarkTrusted(
  */
 
 int
-Tcl_IsSafe(
-    Tcl_Interp *interp)		/* Is this interpreter "safe" ? */
+Tcl_IsSafe(interp)
+    Tcl_Interp *interp;		/* Is this interpreter "safe" ? */
 {
-    Interp *iPtr = (Interp *) interp;
+    Interp *iPtr;
 
-    if (iPtr == NULL) {
-	return 0;
+    if (interp == (Tcl_Interp *) NULL) {
+        return 0;
     }
-    return (iPtr->flags & SAFE_INTERP) ? 1 : 0;
+    iPtr = (Interp *) interp;
+
+    return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;
 }
 
 /*
@@ -3105,50 +2414,34 @@ Tcl_IsSafe(
  * 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(
-    Tcl_Interp *interp)		/* Interpreter to be made safe. */
+Tcl_MakeSafe(interp)
+    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...)
      */
 
     /*
@@ -3157,7 +2450,7 @@ Tcl_MakeSafe(
 
     Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
 
-    /*
+    /* 
      * Remove unsafe parts of tcl_platform
      */
 
@@ -3167,1596 +2460,37 @@ Tcl_MakeSafe(
     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 != NULL) {
-	Tcl_UnregisterChannel(interp, chan);
+    if (chan != (Tcl_Channel) NULL) {
+        Tcl_UnregisterChannel(interp, chan);
     }
     chan = Tcl_GetStdChannel(TCL_STDOUT);
-    if (chan != NULL) {
-	Tcl_UnregisterChannel(interp, chan);
+    if (chan != (Tcl_Channel) NULL) {
+        Tcl_UnregisterChannel(interp, chan);
     }
     chan = Tcl_GetStdChannel(TCL_STDERR);
-    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_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", 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_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL);
-		Tcl_Release(interp);
-		return TCL_ERROR;
-	    }
-	    Tcl_Release(interp);
-	}
+    if (chan != (Tcl_Channel) NULL) {
+        Tcl_UnregisterChannel(interp, chan);
     }
 
     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(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 = 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(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(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(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)");
-	Tcl_BackgroundException(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(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)) {
-	Tcl_BackgroundException(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, &key,
-	    &isNew);
-    if (!isNew) {
-	limitCBPtr = Tcl_GetHashValue(hashPtr);
-	limitCBPtr->entryPtr = NULL;
-	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
-		limitCBPtr);
-    }
-
-    limitCBPtr = 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 *const 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 ...?");
-	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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADVALUE", 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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADVALUE", 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 *const 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 ...?");
-	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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADVALUE", 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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADVALUE", 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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADVALUE", 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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADUSAGE", 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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
-			    "BADUSAGE", 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 a3b42bd..28b1786 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -1,126 +1,103 @@
-/*
+/* 
  * 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;
-	unsigned int ui;
-	short s;
-	unsigned short us;
-	long l;
-	unsigned long ul;
-	Tcl_WideInt w;
-	Tcl_WideUInt uw;
-	float f;
 	double d;
-    } lastValue;		/* Last known value of C variable; used to
+	Tcl_WideInt w;
+    } 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 functions defined later in this file:
+ * Forward references to procedures 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.
- */
-
-#define LinkedVar(type) (*(type *) linkPtr->addr)
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * 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(
-    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(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_Obj *objPtr;
+    Tcl_Obj *objPtr, *resPtr;
     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 = ckalloc(sizeof(Link));
+    linkPtr = (Link *) ckalloc(sizeof(Link));
     linkPtr->interp = interp;
     linkPtr->varName = Tcl_NewStringObj(varName, -1);
     Tcl_IncrRefCount(linkPtr->varName);
@@ -132,17 +109,21 @@ Tcl_LinkVar(
 	linkPtr->flags = 0;
     }
     objPtr = ObjValue(linkPtr);
-    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
-	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+    Tcl_IncrRefCount(objPtr);
+    resPtr = Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
+	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+    Tcl_DecrRefCount(objPtr);
+    if (resPtr == NULL) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	ckfree(linkPtr);
+	ckfree((char *) linkPtr);
 	return TCL_ERROR;
     }
     code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
-	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
+	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
+	    (ClientData) linkPtr);
     if (code != TCL_OK) {
 	Tcl_DecrRefCount(linkPtr->varName);
-	ckfree(linkPtr);
+	ckfree((char *) linkPtr);
     }
     return code;
 }
@@ -158,29 +139,30 @@ Tcl_LinkVar(
  *	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(
-    Tcl_Interp *interp,		/* Interpreter containing variable to unlink */
-    const char *varName)	/* Global variable in interp to unlink. */
+Tcl_UnlinkVar(interp, varName)
+    Tcl_Interp *interp;		/* Interpreter containing variable to unlink. */
+    CONST char *varName;	/* Global variable in interp to unlink. */
 {
-    Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
-	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
+    Link *linkPtr;
 
+    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
+	    LinkTraceProc, (ClientData) NULL);
     if (linkPtr == NULL) {
 	return;
     }
     Tcl_UntraceVar(interp, varName,
 	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
-	    LinkTraceProc, linkPtr);
+	    LinkTraceProc, (ClientData) linkPtr);
     Tcl_DecrRefCount(linkPtr->varName);
-    ckfree(linkPtr);
+    ckfree((char *) linkPtr);
 }
 
 /*
@@ -188,41 +170,45 @@ Tcl_UnlinkVar(
  *
  * Tcl_UpdateLinkedVar --
  *
- *	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.
+ *	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.
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter containing variable. */
-    const char *varName)	/* Name of global variable that is linked. */
+Tcl_UpdateLinkedVar(interp, varName)
+    Tcl_Interp *interp;		/* Interpreter containing variable. */
+    CONST char *varName;	/* Name of global variable that is linked. */
 {
-    Link *linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName,
-	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
+    Link *linkPtr;
     int savedFlag;
+    Tcl_Obj *objPtr;
 
+    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
+	    LinkTraceProc, (ClientData) NULL);
     if (linkPtr == NULL) {
 	return;
     }
     savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
     linkPtr->flags |= LINK_BEING_UPDATED;
-    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
-	    TCL_GLOBAL_ONLY);
+    objPtr = ObjValue(linkPtr);
+    Tcl_IncrRefCount(objPtr);
+    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr, TCL_GLOBAL_ONLY);
+    Tcl_DecrRefCount(objPtr);
     /*
      * Callback may have unlinked the variable. [Bug 1740631]
      */
     linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
-	    LinkTraceProc, NULL);
+	    LinkTraceProc, (ClientData) NULL);
     if (linkPtr != NULL) {
 	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
     }
@@ -233,62 +219,63 @@ Tcl_UpdateLinkedVar(
  *
  * LinkTraceProc --
  *
- *	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.
+ *	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.
  *
  * 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 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, 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. */
 {
-    Link *linkPtr = clientData;
+    Link *linkPtr = (Link *) clientData;
     int changed, valueLength;
-    const char *value;
-    char **pp;
-    Tcl_Obj *valueObj;
-    int valueInt;
-    Tcl_WideInt valueWide;
-    double valueDouble;
+    CONST char *value;
+    char **pp, *result;
+    Tcl_Obj *objPtr, *valueObj, *tmpPtr;
 
     /*
-     * 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) {
 	if (Tcl_InterpDeleted(interp)) {
 	    Tcl_DecrRefCount(linkPtr->varName);
-	    ckfree(linkPtr);
+	    ckfree((char *) linkPtr);
 	} else if (flags & TCL_TRACE_DESTROYED) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	    tmpPtr = ObjValue(linkPtr);
+	    Tcl_IncrRefCount(tmpPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
 		    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, linkPtr);
+		    |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
 	}
 	return NULL;
     }
 
     /*
-     * 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) {
@@ -296,247 +283,146 @@ LinkTraceProc(
     }
 
     /*
-     * 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 = (LinkedVar(int) != linkPtr->lastValue.i);
+	    changed = *(int *)(linkPtr->addr) != linkPtr->lastValue.i;
 	    break;
 	case TCL_LINK_DOUBLE:
-	    changed = (LinkedVar(double) != linkPtr->lastValue.d);
+	    changed = *(double *)(linkPtr->addr) != linkPtr->lastValue.d;
 	    break;
 	case TCL_LINK_WIDE_INT:
-	    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);
+	    changed = *(Tcl_WideInt *)(linkPtr->addr) != linkPtr->lastValue.w;
 	    break;
 	case TCL_LINK_STRING:
 	    changed = 1;
 	    break;
 	default:
-	    return (char *) "internal error: bad linked variable type";
+	    return "internal error: bad linked variable type";
 	}
 	if (changed) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	    tmpPtr = ObjValue(linkPtr);
+	    Tcl_IncrRefCount(tmpPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
 		    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 interp'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 interpreter's result, since the variable access
+     * could occur when the result has been partially set.
      */
 
     if (linkPtr->flags & LINK_READ_ONLY) {
-	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	tmpPtr = ObjValue(linkPtr);
+	Tcl_IncrRefCount(tmpPtr);
+	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
 		TCL_GLOBAL_ONLY);
-	return (char *) "linked variable is read-only";
+	Tcl_DecrRefCount(tmpPtr);
+	return "linked variable is read-only";
     }
     valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
     if (valueObj == NULL) {
 	/*
 	 * This shouldn't ever happen.
 	 */
-
-	return (char *) "internal error: linked variable couldn't be read";
+	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(NULL, valueObj, &linkPtr->lastValue.i)
+	if (Tcl_GetIntFromObj(interp, valueObj, &linkPtr->lastValue.i)
 		!= TCL_OK) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	    Tcl_SetObjResult(interp, objPtr);
+	    tmpPtr = ObjValue(linkPtr);
+	    Tcl_IncrRefCount(tmpPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
 		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have integer value";
+	    Tcl_DecrRefCount(tmpPtr);
+	    result = "variable must have integer value";
+	    goto end;
 	}
-	LinkedVar(int) = linkPtr->lastValue.i;
+	*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
 	break;
 
     case TCL_LINK_WIDE_INT:
-	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
+	if (Tcl_GetWideIntFromObj(interp, valueObj, &linkPtr->lastValue.w)
 		!= TCL_OK) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	    Tcl_SetObjResult(interp, objPtr);
+	    tmpPtr = ObjValue(linkPtr);
+	    Tcl_IncrRefCount(tmpPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
 		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have integer value";
+	    Tcl_DecrRefCount(tmpPtr);
+	    result = "variable must have integer value";
+	    goto end;
 	}
-	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
+	*(Tcl_WideInt *)(linkPtr->addr) = linkPtr->lastValue.w;
 	break;
 
     case TCL_LINK_DOUBLE:
-	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
-		!= TCL_OK) {
-#ifdef ACCEPT_NAN
-	    if (valueObj->typePtr != &tclDoubleType) {
-#endif
-		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
-			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
-		return (char *) "variable must have real value";
-#ifdef ACCEPT_NAN
-	    }
-	    linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
-#endif
-	}
-	LinkedVar(double) = linkPtr->lastValue.d;
-	break;
-
-    case TCL_LINK_BOOLEAN:
-	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
+	if (Tcl_GetDoubleFromObj(interp, valueObj, &linkPtr->lastValue.d)
 		!= TCL_OK) {
-	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+	    Tcl_SetObjResult(interp, objPtr);
+	    tmpPtr = ObjValue(linkPtr);
+	    Tcl_IncrRefCount(tmpPtr);
+	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, tmpPtr,
 		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have boolean value";
+	    Tcl_DecrRefCount(tmpPtr);
+	    result = "variable must have real value";
+	    goto end;
 	}
-	LinkedVar(int) = linkPtr->lastValue.i;
+	*(double *)(linkPtr->addr) = linkPtr->lastValue.d;
 	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 (char *) "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);
-	    return (char *) "variable must have unsigned char value";
-	}
-	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 (char *) "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 (char *) "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 (char *) "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 (char *) "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 (char *) "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 (char *) "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),
+    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,
 		    TCL_GLOBAL_ONLY);
-	    return (char *) "variable must have float value";
+	    Tcl_DecrRefCount(tmpPtr);
+	    result = "variable must have boolean value";
+	    goto end;
 	}
-	linkPtr->lastValue.f = (float)valueDouble;
-	LinkedVar(float) = linkPtr->lastValue.f;
+	*(int *)(linkPtr->addr) = linkPtr->lastValue.i;
 	break;
 
     case TCL_LINK_STRING:
 	value = Tcl_GetStringFromObj(valueObj, &valueLength);
 	valueLength++;
-	pp = (char **) linkPtr->addr;
-
-	*pp = ckrealloc(*pp, valueLength);
+	pp = (char **)(linkPtr->addr);
+	if (*pp != NULL) {
+	    ckfree(*pp);
+	}
+	*pp = (char *) ckalloc((unsigned) valueLength);
 	memcpy(*pp, value, (unsigned) valueLength);
 	break;
 
     default:
-	return (char *) "internal error: bad linked variable type";
+	return "internal error: bad linked variable type";
     }
-    return NULL;
+    end:
+    Tcl_DecrRefCount(objPtr);
+    return result;
 }
 
 /*
@@ -544,12 +430,12 @@ LinkTraceProc(
  *
  * 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.
@@ -558,78 +444,36 @@ LinkTraceProc(
  */
 
 static Tcl_Obj *
-ObjValue(
-    Link *linkPtr)		/* Structure describing linked variable. */
+ObjValue(linkPtr)
+    Link *linkPtr;		/* Structure describing linked variable. */
 {
     char *p;
-    Tcl_Obj *resultObj;
 
     switch (linkPtr->type) {
     case TCL_LINK_INT:
-	linkPtr->lastValue.i = LinkedVar(int);
+	linkPtr->lastValue.i = *(int *)(linkPtr->addr);
 	return Tcl_NewIntObj(linkPtr->lastValue.i);
     case TCL_LINK_WIDE_INT:
-	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
+	linkPtr->lastValue.w = *(Tcl_WideInt *)(linkPtr->addr);
 	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
     case TCL_LINK_DOUBLE:
-	linkPtr->lastValue.d = LinkedVar(double);
+	linkPtr->lastValue.d = *(double *)(linkPtr->addr);
 	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
     case TCL_LINK_BOOLEAN:
-	linkPtr->lastValue.i = LinkedVar(int);
+	linkPtr->lastValue.i = *(int *)(linkPtr->addr);
 	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 = LinkedVar(char *);
+	p = *(char **)(linkPtr->addr);
 	if (p == NULL) {
-	    TclNewLiteralStringObj(resultObj, "NULL");
-	    return resultObj;
+	    return Tcl_NewStringObj("NULL", 4);
 	}
 	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:
-	TclNewLiteralStringObj(resultObj, "??");
-	return resultObj;
+	return Tcl_NewStringObj("??", 2);
     }
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 3668b45..fffe6a2 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1,197 +1,70 @@
-/*
+/* 
  * tclListObj.c --
  *
- *	This file contains functions that implement the Tcl list object type.
+ *	This file contains procedures 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 functions defined later in this file:
+ * Prototypes for procedures defined later in this file:
  */
 
-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);
+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));
 
 /*
- * The structure below defines the list Tcl object type by means of functions
- * that can be invoked by generic object code.
+ * The structure below defines the list Tcl object type by means of
+ * procedures 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.
  */
 
-const Tcl_ObjType tclListType = {
-    "list",			/* name */
-    FreeListInternalRep,	/* freeIntRepProc */
-    DupListInternalRep,		/* dupIntRepProc */
-    UpdateStringOfList,		/* updateStringProc */
-    SetListFromAny		/* setFromAnyProc */
+Tcl_ObjType tclListType = {
+    "list",				/* name */
+    FreeListInternalRep,		/* freeIntRepProc */
+    DupListInternalRep,		        /* dupIntRepProc */
+    UpdateStringOfList,			/* updateStringProc */
+    SetListFromAny			/* setFromAnyProc */
 };
-
-#ifndef TCL_MIN_ELEMENT_GROWTH
-#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 = attemptckalloc(LIST_SIZE(objc));
-    if (listRepPtr == NULL) {
-	if (p) {
-	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
-		    LIST_SIZE(objc));
-	}
-	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",
-		    LIST_SIZE(objc)));
-	}
-	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-    }
-    return listRepPtr;
-}
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_NewListObj --
  *
- *	This function is normally called when not debugging: i.e., when
+ *	This procedure 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 function just returns the result
- *	of calling the debugging version Tcl_DbNewListObj.
+ *	When TCL_MEM_DEBUG is defined, this procedure 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
@@ -204,9 +77,9 @@ AttemptNewList(
 #undef Tcl_NewListObj
 
 Tcl_Obj *
-Tcl_NewListObj(
-    int objc,			/* Count of objects referenced by objv. */
-    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
+Tcl_NewListObj(objc, objv)
+    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);
 }
@@ -214,31 +87,36 @@ Tcl_NewListObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewListObj(
-    int objc,			/* Count of objects referenced by objv. */
-    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
+Tcl_NewListObj(objc, objv)
+    int objc;			/* Count of objects referenced by objv. */
+    Tcl_Obj *CONST objv[];	/* An array of pointers to Tcl objects. */
 {
-    List *listRepPtr;
-    Tcl_Obj *listPtr;
-
+    register Tcl_Obj *listPtr;
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    int i;
+    
     TclNewObj(listPtr);
-
-    if (objc <= 0) {
-	return 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;
     }
-
-    /*
-     * Create the internal rep.
-     */
-
-    listRepPtr = NewListIntRep(objc, objv, 1);
-
-    /*
-     * Now create the object.
-     */
-
-    Tcl_InvalidateStringRep(listPtr);
-    ListSetIntRep(listPtr, listRepPtr);
     return listPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -248,22 +126,22 @@ Tcl_NewListObj(
  *
  * Tcl_DbNewListObj --
  *
- *	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
+ *	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
  *	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 function just returns the
+ *	When TCL_MEM_DEBUG is not defined, this procedure 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
@@ -275,49 +153,53 @@ Tcl_NewListObj(
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-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. */
+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_Obj *listPtr;
-    List *listRepPtr;
-
+    register Tcl_Obj *listPtr;
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    int i;
+    
     TclDbNewObj(listPtr, file, line);
-
-    if (objc <= 0) {
-	return 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;
     }
-
-    /*
-     * Create the internal rep.
-     */
-
-    listRepPtr = NewListIntRep(objc, objv, 1);
-
-    /*
-     * Now create the object.
-     */
-
-    Tcl_InvalidateStringRep(listPtr);
-    ListSetIntRep(listPtr, listRepPtr);
-
     return listPtr;
 }
 
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-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. */
+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. */
 {
     return Tcl_NewListObj(objc, objv);
 }
@@ -328,8 +210,8 @@ Tcl_DbNewListObj(
  *
  * 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.
@@ -337,42 +219,61 @@ Tcl_DbNewListObj(
  * 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(
-    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(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. */
 {
-    List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    register List *listRepPtr;
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    int i;
 
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
+	panic("Tcl_SetListObj called with shared object");
     }
-
+    
     /*
      * Free any old string rep and any internal rep for the old type.
      */
 
-    TclFreeIntRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    objPtr->typePtr = NULL;
     Tcl_InvalidateStringRep(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) {
-	listRepPtr = NewListIntRep(objc, objv, 1);
-	ListSetIntRep(objPtr, listRepPtr);
+	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;
     } else {
 	objPtr->bytes = tclEmptyStringRep;
 	objPtr->length = 0;
@@ -382,66 +283,25 @@ Tcl_SetListObj(
 /*
  *----------------------------------------------------------------------
  *
- * 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 function returns an (objc,objv) array of the elements in a list
- *	object.
+ *	This procedure 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 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.
+ *	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.
  *
  * Side effects:
  *	The possible conversion of the object referenced by listPtr
@@ -451,33 +311,26 @@ TclListObjCopy(
  */
 
 int
-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
+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
 				 * 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;
-
-	if (listPtr->bytes == tclEmptyStringRep) {
-	    *objcPtr = 0;
-	    *objvPtr = NULL;
-	    return TCL_OK;
-	}
-	result = SetListFromAny(interp, listPtr);
+	int result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
-    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
     *objcPtr = listRepPtr->elemCount;
-    *objvPtr = &listRepPtr->elements;
+    *objvPtr = listRepPtr->elements;
     return TCL_OK;
 }
 
@@ -486,51 +339,60 @@ Tcl_ListObjGetElements(
  *
  * Tcl_ListObjAppendList --
  *
- *	This function appends the elements in the list value referenced by
- *	elemListPtr to the list value referenced by listPtr.
+ *	This procedure 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 values, 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(
-    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(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. */
 {
-    int objc;
+    register List *listRepPtr;
+    int listLen, objc, result;
     Tcl_Obj **objv;
 
     if (Tcl_IsShared(listPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
+	panic("Tcl_ListObjAppendList called with shared object");
     }
+    if (listPtr->typePtr != &tclListType) {
+	result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    listLen = listRepPtr->elemCount;
 
-    /*
-     * Pull the elements to append from elemListPtr.
-     */
-
-    if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
-	return TCL_ERROR;
+    result = Tcl_ListObjGetElements(interp, elemListPtr, &objc, &objv);
+    if (result != TCL_OK) {
+	return result;
     }
 
     /*
-     * Insert the new elements starting after the lists's last element.
+     * Insert objc new elements starting after the lists's last element.
      * Delete zero existing elements.
      */
-
-    return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);
+    
+    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
 }
 
 /*
@@ -538,157 +400,78 @@ Tcl_ListObjAppendList(
  *
  * Tcl_ListObjAppendElement --
  *
- *	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.
+ *	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.
  *
  * 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(
-    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(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. */
 {
-    register List *listRepPtr, *newPtr = NULL;
-    int numElems, numRequired, needGrow, isShared, attempt;
-
+    register List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    int numElems, numRequired;
+    
     if (Tcl_IsShared(listPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
+	panic("Tcl_ListObjAppendElement called with shared object");
     }
     if (listPtr->typePtr != &tclListType) {
-	int result;
-
-	if (listPtr->bytes == tclEmptyStringRep) {
-	    Tcl_SetListObj(listPtr, 1, &objPtr);
-	    return TCL_OK;
-	}
-	result = SetListFromAny(interp, listPtr);
+	int result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
 
-    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    elemPtrs = listRepPtr->elements;
     numElems = listRepPtr->elemCount;
     numRequired = numElems + 1 ;
-    needGrow = (numRequired > listRepPtr->maxElemCount);
-    isShared = (listRepPtr->refCount > 1);
-
-    if (numRequired > LIST_MAX) {
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "max length of a Tcl list (%d elements) exceeded",
-		    LIST_MAX));
-	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    if (needGrow && !isShared) {
-	/*
-	 * Need to grow + unshared intrep => try to realloc
-	 */
-
-	attempt = 2 * numRequired;
-	if (attempt <= LIST_MAX) {
-	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
-	}
-	if (newPtr == NULL) {
-	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
-	    if (attempt > LIST_MAX) {
-		attempt = LIST_MAX;
-	    }
-	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
-	}
-	if (newPtr == NULL) {
-	    attempt = numRequired;
-	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
-	}
-	if (newPtr) {
-	    listRepPtr = newPtr;
-	    listRepPtr->maxElemCount = attempt;
-	    needGrow = 0;
-	}
-    }
-    if (isShared || needGrow) {
-	Tcl_Obj **dst, **src = &listRepPtr->elements;
-
-	/*
-	 * Either we have a shared intrep and we must copy to write, or we
-	 * need to grow and realloc attempts failed.  Attempt intrep copy.
-	 */
-
-	attempt = 2 * numRequired;
-	newPtr = AttemptNewList(NULL, attempt, NULL);
-	if (newPtr == NULL) {
-	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
-	    if (attempt > LIST_MAX) {
-		attempt = LIST_MAX;
-	    }
-	    newPtr = AttemptNewList(NULL, attempt, NULL);
-	}
-	if (newPtr == NULL) {
-	    attempt = numRequired;
-	    newPtr = AttemptNewList(interp, attempt, NULL);
-	}
-	if (newPtr == NULL) {
-	    /*
-	     * All growth attempts failed; throw the error.
-	     */
-
-	    return TCL_ERROR;
-	}
-
-	dst = &newPtr->elements;
-	newPtr->refCount++;
-	newPtr->canonicalFlag = listRepPtr->canonicalFlag;
-	newPtr->elemCount = listRepPtr->elemCount;
-
-	if (isShared) {
-	    /*
-	     * The original intrep must remain undisturbed.  Copy into the new
-	     * one and bump refcounts
-	     */
-	    while (numElems--) {
-		*dst = *src++;
-		Tcl_IncrRefCount(*dst++);
-	    }
-	    listRepPtr->refCount--;
-	} else {
-	    /*
-	     * Old intrep to be freed, re-use refCounts.
-	     */
+    
+    /*
+     * If there is no room in the current array of element pointers,
+     * allocate a new, larger array and copy the pointers to it.
+     */
 
-	    memcpy(dst, src, (size_t) numElems * sizeof(Tcl_Obj *));
-	    ckfree(listRepPtr);
-	}
-	listRepPtr = newPtr;
+    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;
     }
-    listPtr->internalRep.twoPtrValue.ptr1 = 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.
      */
 
-    *(&listRepPtr->elements + listRepPtr->elemCount) = objPtr;
+    elemPtrs[numElems] = objPtr;
     Tcl_IncrRefCount(objPtr);
     listRepPtr->elemCount++;
 
@@ -706,20 +489,20 @@ Tcl_ListObjAppendElement(
  *
  * Tcl_ListObjIndex --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -728,34 +511,28 @@ Tcl_ListObjAppendElement(
  */
 
 int
-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. */
+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. */
 {
     register List *listRepPtr;
-
+    
     if (listPtr->typePtr != &tclListType) {
-	int result;
-
-	if (listPtr->bytes == tclEmptyStringRep) {
-	    *objPtrPtr = NULL;
-	    return TCL_OK;
-	}
-	result = SetListFromAny(interp, listPtr);
+	int result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
 
-    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
     if ((index < 0) || (index >= listRepPtr->elemCount)) {
 	*objPtrPtr = NULL;
     } else {
-	*objPtrPtr = (&listRepPtr->elements)[index];
+	*objPtrPtr = listRepPtr->elements[index];
     }
-
+    
     return TCL_OK;
 }
 
@@ -764,16 +541,16 @@ Tcl_ListObjIndex(
  *
  * Tcl_ListObjLength --
  *
- *	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
+ *	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
  *	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.
@@ -782,27 +559,21 @@ Tcl_ListObjIndex(
  */
 
 int
-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. */
+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. */
 {
     register List *listRepPtr;
-
+    
     if (listPtr->typePtr != &tclListType) {
-	int result;
-
-	if (listPtr->bytes == tclEmptyStringRep) {
-	    *intPtr = 0;
-	    return TCL_OK;
-	}
-	result = SetListFromAny(interp, listPtr);
+	int result = SetListFromAny(interp, listPtr);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
 
-    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
     *intPtr = listRepPtr->elemCount;
     return TCL_OK;
 }
@@ -811,238 +582,178 @@ Tcl_ListObjLength(
  *----------------------------------------------------------------------
  *
  * Tcl_ListObjReplace --
- *
- *	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.
+ * 
+ *	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.
  *
  *	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(
-    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(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. */
 {
     List *listRepPtr;
-    register Tcl_Obj **elemPtrs;
-    int numElems, numRequired, numAfterLast, start, i, j, isShared;
-
+    register Tcl_Obj **elemPtrs, **newPtrs;
+    Tcl_Obj *victimPtr;
+    int numElems, numRequired, numAfterLast;
+    int start, shift, newMax, i, j, result;
+     
     if (Tcl_IsShared(listPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
+	panic("Tcl_ListObjReplace called with shared object");
     }
     if (listPtr->typePtr != &tclListType) {
-	if (listPtr->bytes == tclEmptyStringRep) {
-	    if (!objc) {
-		return TCL_OK;
-	    }
-	    Tcl_SetListObj(listPtr, objc, NULL);
-	} else {
-	    int result = SetListFromAny(interp, listPtr);
-
-	    if (result != TCL_OK) {
-		return result;
-	    }
+	result = SetListFromAny(interp, listPtr);
+	if (result != TCL_OK) {
+	    return result;
 	}
     }
-
-    /*
-     * 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;
+    listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
+    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;
-
-    if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
-	int shift;
-
+    
+    numRequired = (numElems - count + objc);
+    if (numRequired <= listRepPtr->maxElemCount) {
 	/*
-	 * Can use the current List struct. First "delete" count elements
-	 * starting at first.
+	 * Enough room in the current array. First "delete" count
+	 * elements starting at first.
 	 */
 
-	for (j = first;  j < first + count;  j++) {
-	    Tcl_Obj *victimPtr = elemPtrs[j];
-
+	for (i = 0, j = first;  i < count;  i++, j++) {
+	    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 = elemPtrs + start;
+	    Tcl_Obj **src, **dst;
 
-	    memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
+	    src = elemPtrs + start; dst = src + shift;
+	    memmove((VOID*) dst, (VOID*) src, 
+	            (size_t) (numAfterLast * sizeof(Tcl_Obj*)));
 	}
-    } else {
+
 	/*
-	 * Cannot use the current List struct; it is shared, too small, or
-	 * both. Allocate a new struct and insert elements into it.
+	 * Insert the new elements into elemPtrs before "first".
 	 */
 
-	List *oldListRepPtr = listRepPtr;
-	Tcl_Obj **oldPtrs = elemPtrs;
-	int newMax;
-
-	if (numRequired > listRepPtr->maxElemCount){
-	    newMax = 2 * numRequired;
-	} else {
-	    newMax = listRepPtr->maxElemCount;
-	}
-
-	listRepPtr = AttemptNewList(NULL, newMax, NULL);
-	if (listRepPtr == NULL) {
-	    unsigned int limit = LIST_MAX - numRequired;
-	    unsigned int extra = numRequired - numElems
-		    + TCL_MIN_ELEMENT_GROWTH;
-	    int growth = (int) ((extra > limit) ? limit : extra);
-
-	    listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);
-	    if (listRepPtr == NULL) {
-		listRepPtr = AttemptNewList(interp, numRequired, NULL);
-		if (listRepPtr == NULL) {
-		    return TCL_ERROR;
-		}
-	    }
-	}
-
-	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
-	listRepPtr->refCount++;
+	for (i = 0, j = first;  i < objc;  i++, j++) {
+            elemPtrs[j] = objv[i];
+            Tcl_IncrRefCount(objv[i]);
+        }
 
-	elemPtrs = &listRepPtr->elements;
-
-	if (isShared) {
-	    /*
-	     * The old struct will remain in place; need new refCounts for the
-	     * new List struct references. Copy over only the surviving
-	     * elements.
-	     */
-
-	    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]);
-	    }
+	/*
+	 * Update the count of elements.
+	 */
 
-	    oldListRepPtr->refCount--;
-	} else {
-	    /*
-	     * The old struct will be removed; use its inherited refCounts.
-	     */
+	listRepPtr->elemCount = numRequired;
+    } else {
+	/*
+	 * Not enough room in the current array. Allocate a larger array and
+	 * insert elements into it. 
+	 */
 
-	    if (first > 0) {
-		memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
-	    }
+	newMax = (2 * numRequired);
+	newPtrs = (Tcl_Obj **)
+	    ckalloc((unsigned) (newMax * sizeof(Tcl_Obj *)));
 
-	    /*
-	     * "Delete" count elements starting at first.
-	     */
+	/*
+	 * Copy over the elements before "first".
+	 */
 
-	    for (j = first;  j < first + count;  j++) {
-		Tcl_Obj *victimPtr = oldPtrs[j];
+	if (first > 0) {
+	    memcpy((VOID *) newPtrs, (VOID *) elemPtrs,
+		    (size_t) (first * sizeof(Tcl_Obj *)));
+	}
 
-		TclDecrRefCount(victimPtr);
-	    }
+	/*
+	 * "Delete" count elements starting at first.
+	 */
 
-	    /*
-	     * Copy the elements after the last one removed, shifted to their
-	     * new locations.
-	     */
+	for (i = 0, j = first;  i < count;  i++, j++) {
+	    victimPtr = elemPtrs[j];
+	    TclDecrRefCount(victimPtr);
+	}
 
-	    start = first + count;
-	    numAfterLast = numElems - start;
-	    if (numAfterLast > 0) {
-		memcpy(elemPtrs + first + objc, oldPtrs + start,
-			(size_t) numAfterLast * sizeof(Tcl_Obj *));
-	    }
+	/*
+	 * Copy the elements after the last one removed, shifted to
+	 * their new locations.
+	 */
 
-	    ckfree(oldListRepPtr);
+	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.
+	 */
 
-    /*
-     * Insert the new elements into elemPtrs before "first". We don't do a
-     * memcpy here because we must increment the reference counts for the
-     * added elements, so we must explicitly loop anyway.
-     */
+	for (i = 0, j = first;  i < objc;  i++, j++) {
+	    newPtrs[j] = objv[i];
+	    Tcl_IncrRefCount(objv[i]);
+	}
 
-    for (i=0,j=first ; i<objc ; i++,j++) {
-	elemPtrs[j] = objv[i];
-	Tcl_IncrRefCount(objv[i]);
+	listRepPtr->elemCount = numRequired;
+	listRepPtr->maxElemCount = newMax;
+	listRepPtr->elements = newPtrs;
+	ckfree((char *) elemPtrs);
     }
-
-    /*
-     * 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.
@@ -1055,258 +766,270 @@ Tcl_ListObjReplace(
 /*
  *----------------------------------------------------------------------
  *
- * TclLindexList --
- *
- *	This procedure handles the 'lindex' command when objc==3.
+ * TclLsetList --
+ *	
+ *	Core of the 'lset' command when objc == 4.  Objv[2] may be
+ *	either a scalar index or a list of indices.
  *
  * 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.
+ *	Returns the new value of the list variable, or NULL if an
+ *	error occurs.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-TclLindexList(
-    Tcl_Interp *interp,		/* Tcl interpreter. */
-    Tcl_Obj *listPtr,		/* List being unpacked. */
-    Tcl_Obj *argPtr)		/* Index or index list. */
+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' */
 {
+    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 *indexListCopy;
 
     /*
-     * 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.
+     * 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 (argPtr->typePtr != &tclListType
-	    && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
+    if ( indexArgPtr->typePtr != &tclListType
+	 && TclGetIntForIndex( NULL, indexArgPtr, 0, &index ) == TCL_OK ) {
+
 	/*
-	 * argPtr designates a single index.
+	 * indexArgPtr designates a single index.
 	 */
 
-	return TclLindexFlat(interp, listPtr, 1, &argPtr);
-    }
+	return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
 
-    /*
-     * 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.
-     */
+    } else if ( Tcl_ListObjGetElements( NULL, indexArgPtr,
+					&indexCount, &indices ) != TCL_OK ) {
 
-    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.
+	 * indexArgPtr designates something that is neither an index nor a
+	 * well formed list.  Report the error via TclLsetFlat.
 	 */
 
-	return TclLindexFlat(interp, listPtr, 1, &argPtr);
+	return TclLsetFlat( interp, listPtr, 1, &indexArgPtr, valuePtr );
+
     }
 
-    if (indexListCopy->typePtr == &tclListType) {
-	List *listRepPtr = ListRepPtr(indexListCopy);
+    /*
+     * 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.
+     */
 
-	listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
-		&listRepPtr->elements);
-    } else {
-	int indexCount = -1;	/* Size of the array of list indices. */
-	Tcl_Obj **indices = NULL;
-				/* Array of list indices. */
+    if ( indexCount == 0 ) {
+	Tcl_IncrRefCount( valuePtr );
+	return valuePtr;
+    }
 
-	Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
-	listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
+    /*
+     * Duplicate the list arg if necessary.
+     */
+
+    if ( Tcl_IsShared( listPtr ) ) {
+	duplicated = 1;
+	listPtr = Tcl_DuplicateObj( listPtr );
+	Tcl_IncrRefCount( listPtr );
+    } else {
+	duplicated = 0;
     }
-    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);
- *
- *----------------------------------------------------------------------
- */
 
-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;
+    /*
+     * 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.
+     */
 
-    Tcl_IncrRefCount(listPtr);
+    /*
+     * Anchor the linked list of Tcl_Obj's whose string reps must be
+     * invalidated if the operation succeeds.
+     */
 
-    for (i=0 ; i<indexCount && listPtr ; i++) {
-	int index, listLen = 0;
-	Tcl_Obj **elemPtrs = NULL, *sublistCopy;
+    retValuePtr = listPtr;
+    chainPtr = NULL;
+
+    /*
+     * Handle each index arg by diving into the appropriate sublist
+     */
+
+    for ( i = 0; ; ++i ) {
 
 	/*
-	 * 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.
+	 * Take the sublist apart.
 	 */
 
-	sublistCopy = TclListObjCopy(interp, listPtr);
-	Tcl_DecrRefCount(listPtr);
-	listPtr = NULL;
+	result = Tcl_ListObjGetElements( interp, listPtr,
+					 &elemCount, &elemPtrs );
+	if ( result != TCL_OK ) {
+	    break;
+	}
+	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
+
+	/*
+	 * Reconstitute the index array
+	 */
 
-	if (sublistCopy == NULL) {
-	    /*
-	     * The sublist is not a list at all => error.
+	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.
 	     */
+	    break;
+	}
 
+	/*
+	 * Determine the index of the requested element.
+	 */
+
+	result = TclGetIntForIndex( interp, indices[ i ],
+				    (elemCount - 1), &index );
+	if ( result != TCL_OK ) {
 	    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
-		 */
+	
+	/*
+	 * Check that the index is in range.
+	 */
 
-		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.
-		 */
+	if ( ( index < 0 ) || ( index >= elemCount ) ) {
+	    Tcl_SetObjResult( interp,
+			      Tcl_NewStringObj( "list index out of range",
+						-1 ) );
+	    result = TCL_ERROR;
+	    break;
+	}
+
+	/*
+	 * Break the loop after extracting the innermost sublist
+	 */
 
-		listPtr = elemPtrs[index];
+	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.
+		 */
+		break;
 	    }
-	    Tcl_IncrRefCount(listPtr);
 	}
-	Tcl_DecrRefCount(sublistCopy);
-    }
 
-    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.
- *
- *----------------------------------------------------------------------
- */
+	/* 
+	 * Chain the current sublist onto the linked list of Tcl_Obj's
+	 * whose string reps must be spoilt.
+	 */
 
-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 = 0;		/* Number of indices in the index list. */
-    Tcl_Obj **indices = NULL;	/* 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;
+	chainPtr = listPtr;
+	listPtr = subListPtr;
+
+    }
 
     /*
-     * 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.
+     * Store the new element into the correct slot in the innermost sublist.
      */
 
-    if (indexArgPtr->typePtr != &tclListType
-	    && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
-	/*
-	 * indexArgPtr designates a single index.
-	 */
+    if ( result == TCL_OK ) {
+	result = TclListObjSetElement( interp, listPtr, index, valuePtr );
+    }
 
-	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
+    if ( result == TCL_OK ) {
 
-    }
+	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
 
-    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.
-	 */
+	/* 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;
+	}
 
-	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);
+	/* Return the new list if everything worked. */
+	
+	if ( !duplicated ) {
+	    Tcl_IncrRefCount( retValuePtr );
+	}
+	return retValuePtr;
     }
-    TclListObjGetElements(NULL, indexArgPtr, &indexCount, &indices);
 
-    /*
-     * Let TclLsetFlat handle the actual lset'ting.
-     */
+    /* Clean up the one dangling reference otherwise */
 
-    retValuePtr = TclLsetFlat(interp, listPtr, indexCount, indices, valuePtr);
+    if ( duplicated ) {
+	Tcl_DecrRefCount( retValuePtr );
+    }
+    return NULL;
 
-    Tcl_DecrRefCount(indexListCopy);
-    return retValuePtr;
 }
 
 /*
@@ -1314,245 +1037,220 @@ TclLsetList(
  *
  * TclLsetFlat --
  *
- *	Core engine of the 'lset' command.
+ *	Core of the 'lset' command when objc>=5.  Objv[2], ... ,
+ *	objv[objc-2] contain scalar indices.
  *
  * Results:
- *	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.
+ *	Returns the new value of the list variable, or NULL if an
+ *	error occurs.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-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'. */
+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' */
 {
-    int index, result, len;
-    Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
+
+    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;
 
     /*
-     * If there are no indices, simply return the new value.  (Without
-     * indices, [lset] is a synonym for [set].
+     * If there are no indices, then simply return the new value,
+     * counting the returned pointer as a reference
      */
 
-    if (indexCount == 0) {
-	Tcl_IncrRefCount(valuePtr);
+    if ( indexCount == 0 ) {
+	Tcl_IncrRefCount( valuePtr );
 	return valuePtr;
     }
 
     /*
-     * 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 the list is shared, make a private copy.
      */
 
-    subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;
+    if ( Tcl_IsShared( listPtr ) ) {
+	duplicated = 1;
+	listPtr = Tcl_DuplicateObj( listPtr );
+	Tcl_IncrRefCount( listPtr );
+    } else {
+	duplicated = 0;
+    }
 
     /*
      * Anchor the linked list of Tcl_Obj's whose string reps must be
      * invalidated if the operation succeeds.
      */
 
-    retValuePtr = subListPtr;
+    retValuePtr = listPtr;
     chainPtr = NULL;
-    result = TCL_OK;
 
     /*
-     * Loop through all the index arguments, and for each one dive into the
-     * appropriate sublist.
+     * Handle each index arg by diving into the appropriate sublist
      */
 
-    do {
-	int elemCount;
-	Tcl_Obj *parentList, **elemPtrs;
+    for ( i = 0; ; ++i ) {
 
 	/*
-	 * Check for the possible error conditions...
+	 * Take the sublist apart.
 	 */
 
-	if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
-		!= TCL_OK) {
-	    /* ...the sublist we're indexing into isn't a list at all. */
-	    result = TCL_ERROR;
+	result = Tcl_ListObjGetElements( interp, listPtr,
+					 &elemCount, &elemPtrs );
+	if ( result != TCL_OK ) {
 	    break;
 	}
+	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
 
 	/*
-	 * WARNING: the macro TclGetIntForIndexM is not safe for
-	 * post-increments, avoid '*indexArray++' here.
+	 * Determine the index of the requested element.
 	 */
 
-	if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
-		!= TCL_OK)  {
-	    /* ...the index we're trying to use isn't an index at all. */
-	    result = TCL_ERROR;
-	    indexArray++;
+	result = TclGetIntForIndex( interp, indexArray[ i ],
+				    (elemCount - 1), &index );
+	if ( result != TCL_OK ) {
 	    break;
 	}
-	indexArray++;
-
-	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));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
-			"BADINDEX", NULL);
-	    }
+	
+	/*
+	 * 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;
 	}
 
 	/*
-	 * 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.
+	 * Break the loop after extracting the innermost sublist
 	 */
 
-	if (--indexCount) {
-	    parentList = subListPtr;
-	    if (index == elemCount) {
-		subListPtr = Tcl_NewObj();
-	    } else {
-		subListPtr = elemPtrs[index];
-	    }
-	    if (Tcl_IsShared(subListPtr)) {
-		subListPtr = Tcl_DuplicateObj(subListPtr);
-	    }
-
-	    /*
-	     * 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.
-	     */
+	if ( i >= indexCount-1 ) {
+	    result = TCL_OK;
+	    break;
+	}
+	
+	/*
+	 * Extract the appropriate sublist, and make sure that it is unshared.
+	 */
 
-	    if (index == elemCount) {
-		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
-	    } else {
-		TclListObjSetElement(NULL, parentList, index, subListPtr);
-	    }
-	    if (Tcl_IsShared(subListPtr)) {
-		subListPtr = Tcl_DuplicateObj(subListPtr);
-		TclListObjSetElement(NULL, parentList, index, subListPtr);
+	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;
 	    }
-
-	    /*
-	     * 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.
-	     */
-
-	    parentList->internalRep.twoPtrValue.ptr2 = chainPtr;
-	    chainPtr = parentList;
 	}
-    } while (indexCount > 0);
-
-    /*
-     * 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.
-     */
 
-    while (chainPtr) {
-	Tcl_Obj *objPtr = chainPtr;
+	/* 
+	 * Chain the current sublist onto the linked list of Tcl_Obj's
+	 * whose string reps must be spoilt.
+	 */
 
-	if (result == TCL_OK) {
-	    /*
-	     * We're going to store valuePtr, so spoil string reps of all
-	     * containing lists.
-	     */
+	chainPtr = listPtr;
+	listPtr = subListPtr;
 
-	    Tcl_InvalidateStringRep(objPtr);
-	}
+    }
 
-	/*
-	 * Clear away our intrep surgery mess.
-	 */
+    /* Store the result in the list element */
 
-	chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
-	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    if ( result == TCL_OK ) {
+	result = TclListObjSetElement( interp, listPtr, index, valuePtr );
     }
 
-    if (result != TCL_OK) {
-	/*
-	 * Error return; message is already in interp. Clean up any excess
-	 * memory.
-	 */
+    if ( result == TCL_OK ) {
+
+	listPtr->internalRep.twoPtrValue.ptr2 = (VOID *) chainPtr;
 
-	if (retValuePtr != listPtr) {
-	    Tcl_DecrRefCount(retValuePtr);
+	/* 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;
 	}
-	return NULL;
+
+	/* Return the new list if everything worked. */
+	
+	if ( !duplicated ) {
+	    Tcl_IncrRefCount( retValuePtr );
+	}
+	return retValuePtr;
     }
 
-    /*
-     * Store valuePtr in proper sublist and return. The -1 is to avoid a
-     * compiler warning (not a problem because we checked that we have a
-     * proper list - or something convertible to one - above).
-     */
+    /* Clean up the one dangling reference otherwise */
 
-    len = -1;
-    TclListObjLength(NULL, subListPtr, &len);
-    if (index == len) {
-	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
-    } else {
-	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+    if ( duplicated ) {
+	Tcl_DecrRefCount( retValuePtr );
     }
-    Tcl_InvalidateStringRep(subListPtr);
-    Tcl_IncrRefCount(retValuePtr);
-    return retValuePtr;
+    return NULL;
+
 }
 
 /*
@@ -1563,133 +1261,86 @@ TclLsetFlat(
  *	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.
  *
- *	It is the caller's responsibility to invalidate the string
- *	representation of the 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.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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. */
+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 */
 {
-    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. */
+    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 */
 
-    /*
-     * Ensure that the listPtr parameter designates an unshared list.
-     */
+    /* Ensure that the listPtr parameter designates an unshared list */
 
-    if (Tcl_IsShared(listPtr)) {
-	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
+    if ( Tcl_IsShared( listPtr ) ) {
+	panic( "Tcl_ListObjSetElement called with shared object" );
     }
-    if (listPtr->typePtr != &tclListType) {
-	int result;
-
-	if (listPtr->bytes == tclEmptyStringRep) {
-	    if (interp != NULL) {
-		Tcl_SetObjResult(interp,
-			Tcl_NewStringObj("list index out of range", -1));
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
-			"BADINDEX", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	result = SetListFromAny(interp, listPtr);
-	if (result != TCL_OK) {
+    if ( listPtr->typePtr != &tclListType ) {
+	result = SetListFromAny( interp, listPtr );
+	if ( result != TCL_OK ) {
 	    return result;
 	}
     }
-
-    listRepPtr = ListRepPtr(listPtr);
+    listRepPtr = (List*) listPtr->internalRep.twoPtrValue.ptr1;
+    elemPtrs = listRepPtr->elements;
     elemCount = listRepPtr->elemCount;
 
-    /*
-     * Ensure that the index is in bounds.
-     */
+    /* 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));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET", "BADINDEX",
-		    NULL);
+    if ( index < 0 || index >= elemCount ) {
+	if ( interp != NULL ) {
+	    Tcl_SetObjResult( interp,
+			      Tcl_NewStringObj( "list index out of range",
+						-1 ) );
+	    return TCL_ERROR;
 	}
-	return TCL_ERROR;
     }
 
-    /*
-     * If the internal rep is shared, replace it with an unshared copy.
-     */
-
-    if (listRepPtr->refCount > 1) {
-	Tcl_Obj **dst, **src = &listRepPtr->elements;
-	List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL);
-
-	if (newPtr == NULL) {
-	    newPtr = AttemptNewList(interp, elemCount, NULL);
-	    if (newPtr == NULL) {
-		return TCL_ERROR;
-	    }
-	}
-	newPtr->refCount++;
-	newPtr->elemCount = elemCount;
-	newPtr->canonicalFlag = listRepPtr->canonicalFlag;
-
-	dst = &newPtr->elements;
-	while (elemCount--) {
-	    *dst = *src++;
-	    Tcl_IncrRefCount(*dst++);
-	}
+    /* Add a reference to the new list element */
 
-	listRepPtr->refCount--;
+    Tcl_IncrRefCount( valuePtr );
 
-	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
-    }
-    elemPtrs = &listRepPtr->elements;
+    /* Remove a reference from the old list element */
 
-    /*
-     * Add a reference to the new list element.
-     */
+    Tcl_DecrRefCount( elemPtrs[ index ] );
 
-    Tcl_IncrRefCount(valuePtr);
+    /* Stash the new object in the list */
 
-    /*
-     * Remove a reference from the old list element.
-     */
-
-    Tcl_DecrRefCount(elemPtrs[index]);
-
-    /*
-     * Stash the new object in the list.
-     */
-
-    elemPtrs[index] = valuePtr;
+    elemPtrs[ index ] = valuePtr;
 
     return TCL_OK;
+    
 }
 
 /*
@@ -1705,31 +1356,31 @@ TclListObjSetElement(
  *
  * 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(
-    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
+FreeListInternalRep(listPtr)
+    Tcl_Obj *listPtr;		/* List object with internal rep to free. */
 {
-    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(listRepPtr);
+    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);
     }
+    ckfree((char *) elemPtrs);
+    ckfree((char *) listRepPtr);
 
     listPtr->internalRep.twoPtrValue.ptr1 = NULL;
     listPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    listPtr->typePtr = NULL;
 }
 
 /*
@@ -1737,26 +1388,57 @@ FreeListInternalRep(
  *
  * DupListInternalRep --
  *
- *	Initialize the internal representation of a list Tcl_Obj to share the
- *	internal representation of an existing list object.
+ *	Initialize the internal representation of a list Tcl_Obj to a
+ *	copy of the internal representation of an existing list object. 
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The reference count of the List internal rep is incremented.
+ *	"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.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-DupListInternalRep(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+DupListInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
 {
-    List *listRepPtr = ListRepPtr(srcPtr);
+    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;
 
-    ListSetIntRep(copyPtr, listRepPtr);
+    /*
+     * 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;
 }
 
 /*
@@ -1764,7 +1446,8 @@ DupListInternalRep(
  *
  * 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
@@ -1779,117 +1462,110 @@ DupListInternalRep(
  */
 
 static int
-SetListFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr)		/* The object to convert. */
+SetListFromAny(interp, objPtr)
+    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;
 
     /*
-     * 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).
+     * Get the string representation. Make it up-to-date if necessary.
      */
 
-    if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
-	Tcl_Obj *keyPtr, *valuePtr;
-	Tcl_DictSearch search;
-	int done, size;
+    string = Tcl_GetStringFromObj(objPtr, &length);
 
-	/*
-	 * 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.
-	 */
+    /*
+     * 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.
+     */
 
-	Tcl_DictObjSize(NULL, objPtr, &size);
-	listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL);
-	if (!listRepPtr) {
-	    return TCL_ERROR;
+    limit = (string + length);
+    estCount = 1;
+    for (p = string;  p < limit;  p++) {
+	if (isspace(UCHAR(*p))) { /* INTL: ISO space. */
+	    estCount++;
 	}
-	listRepPtr->elemCount = 2 * size;
+    }
 
-	/*
-	 * Populate the list representation.
-	 */
+    /*
+     * 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.
+     */
 
-	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);
+    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;
 	}
-    } else {
-	int estCount, length;
-	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
-
-	/*
-	 * Allocate enough space to hold a (Tcl_Obj *) for each
-	 * (possible) list element.
-	 */
-
-	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;
+	if (elemStart >= limit) {
+	    break;
+	}
+	if (i > estCount) {
+	    panic("SetListFromAny: bad size estimate for list");
 	}
-	elemPtrs = &listRepPtr->elements;
 
 	/*
-	 * Each iteration, parse and store a list element.
+	 * Allocate a Tcl object for the element and initialize it from the
+	 * "elemSize" bytes starting at "elemStart".
 	 */
 
-	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. */
+	s = ckalloc((unsigned) elemSize + 1);
+	if (hasBrace) {
+	    memcpy((VOID *) s, (VOID *) elemStart,  (size_t) elemSize);
+	    s[elemSize] = 0;
+	} else {
+	    elemSize = TclCopyAndCollapse(elemSize, elemStart, s);
 	}
-
- 	listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
+	
+	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;
+
     /*
-     * 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.
      */
 
-    TclFreeIntRep(objPtr);
-    ListSetIntRep(objPtr, listRepPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) listRepPtr;
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->typePtr = &tclListType;
     return TCL_OK;
 }
 
@@ -1898,53 +1574,39 @@ SetListFromAny(
  *
  * UpdateStringOfList --
  *
- *	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.
+ *	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. 
  *
  * 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(
-    Tcl_Obj *listPtr)		/* List object with string rep to update. */
+UpdateStringOfList(listPtr)
+    Tcl_Obj *listPtr;		/* List object with string rep to update. */
 {
 #   define LOCAL_SIZE 20
-    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
-    List *listRepPtr = ListRepPtr(listPtr);
+    int localFlags[LOCAL_SIZE], *flagPtr;
+    List *listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1;
     int numElems = listRepPtr->elemCount;
-    int i, length, bytesNeeded = 0;
-    const char *elem;
-    char *dst;
-    Tcl_Obj **elemPtrs;
-
-    /*
-     * 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;
+    register int i;
+    char *elem, *dst;
+    int length;
 
     /*
-     * Handle empty list case first, so rest of the routine is simpler.
+     * Convert each element of the list to string form and then convert it
+     * to proper list element form, adding it to the result buffer.
      */
 
-    if (numElems == 0) {
-	listPtr->bytes = tclEmptyStringRep;
-	listPtr->length = 0;
-	return;
-    }
-
     /*
      * Pass 1: estimate space, gather flags.
      */
@@ -1952,50 +1614,41 @@ UpdateStringOfList(
     if (numElems <= LOCAL_SIZE) {
 	flagPtr = localFlags;
     } else {
-	/*
-	 * We know numElems <= LIST_MAX, so this is safe.
-	 */
-
-	flagPtr = ckalloc(numElems * sizeof(int));
+	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
     }
-    elemPtrs = &listRepPtr->elements;
+    listPtr->length = 1;
     for (i = 0; i < numElems; i++) {
-	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);
+	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");
 	}
     }
-    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->length = bytesNeeded - 1;
-    listPtr->bytes = ckalloc(bytesNeeded);
+    listPtr->bytes = ckalloc((unsigned) listPtr->length);
     dst = listPtr->bytes;
     for (i = 0; i < numElems; i++) {
-	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
-	elem = TclGetStringFromObj(elemPtrs[i], &length);
-	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
-	*dst++ = ' ';
+	elem = Tcl_GetStringFromObj(listRepPtr->elements[i], &length);
+	dst += Tcl_ConvertCountedElement(elem, length, dst, flagPtr[i]);
+	*dst = ' ';
+	dst++;
     }
-    listPtr->bytes[listPtr->length] = '\0';
-
     if (flagPtr != localFlags) {
-	ckfree(flagPtr);
+	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 441ea91..0c88303 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -1,74 +1,76 @@
-/*
+/* 
  * 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
 
 /*
- * Function prototypes for static functions in this file:
+ * Procedure prototypes for static procedures in this file:
  */
 
-static int		AddLocalLiteralEntry(CompileEnv *envPtr,
-			    Tcl_Obj *objPtr, int localHash);
-static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
-static unsigned		HashString(const char *string, int length);
-static void		RebuildLiteralTable(LiteralTable *tablePtr);
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * TclInitLiteralTable --
  *
- *	This function is called to initialize the fields of a literal table
+ *	This procedure 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(
-    register LiteralTable *tablePtr)
-				/* Pointer to table structure, which is
-				 * supplied by the caller. */
+TclInitLiteralTable(tablePtr)
+    register LiteralTable *tablePtr; /* Pointer to table structure, which
+				      * is supplied by the caller. */
 {
-#if (TCL_SMALL_HASH_TABLE != 4)
-    Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable",
+#if (TCL_SMALL_HASH_TABLE != 4) 
+    panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
 	    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;
 }
 
@@ -77,58 +79,49 @@ TclInitLiteralTable(
  *
  * TclDeleteLiteralTable --
  *
- *	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.
+ *	This procedure frees up everything associated with a literal table
+ *	except for the table's structure itself.
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter containing shared literals
+TclDeleteLiteralTable(interp, tablePtr)
+    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, *nextPtr;
-    Tcl_Obj *objPtr;
-    int i;
+    LiteralEntry *entryPtr;
+    int i, start;
 
     /*
-     * 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*/
 
-    /*
-     * 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(entryPtr);
-	    entryPtr = nextPtr;
+    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;
+	    }
 	}
     }
 
@@ -137,280 +130,206 @@ TclDeleteLiteralTable(
      */
 
     if (tablePtr->buckets != tablePtr->staticBuckets) {
-	ckfree(tablePtr->buckets);
+	ckfree((char *) tablePtr->buckets);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclCreateLiteral --
+ * TclRegisterLiteral --
  *
- *	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.
+ *	Find, or if necessary create, an object in a CompileEnv literal
+ *	array that has a string representation matching the argument string.
  *
  * Results:
- *	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.
+ *	The index in the CompileEnv's literal array that references a
+ *	shared literal matching the string. The object is created if
+ *	necessary.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-TclCreateLiteral(
-    Interp *iPtr,
-    char *bytes,		/* The start of the string. Note that this is
-				 * not a NUL-terminated string. */
-    int length,			/* Number of bytes in the string. */
-    unsigned hash,		/* The string's hash. If -1, it will be
-				 * computed here. */
-    int *newPtr,
-    Namespace *nsPtr,
-    int flags,
-    LiteralEntry **globalPtrPtr)
+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. */
 {
-    LiteralTable *globalTablePtr = &iPtr->literalTable;
-    LiteralEntry *globalPtr;
-    int globalHash;
-    Tcl_Obj *objPtr;
+    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);
 
     /*
-     * Is it in the interpreter's global literal table?
+     * Is the literal already in the CompileEnv's local literal array?
+     * If so, just return its index.
      */
 
-    if (hash == (unsigned) -1) {
-	hash = HashString(bytes, length);
+    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;
+	}
     }
+
+    /*
+     * 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 ((globalPtr->nsPtr == nsPtr)
-		&& (objPtr->length == length) && ((length == 0)
+	if ((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 literal was found: return it
+	     * A global literal was found. Add an entry to the CompileEnv's
+	     * local literal array.
 	     */
-
-	    if (newPtr) {
-		*newPtr = 0;
-	    }
-	    if (globalPtrPtr) {
-		*globalPtrPtr = globalPtr;
-	    }
-	    if (flags & LITERAL_ON_HEAP) {
+	    
+	    if (onHeap) {
 		ckfree(bytes);
 	    }
-	    globalPtr->refCount++;
-	    return objPtr;
-	}
-    }
-    if (!newPtr) {
-	if (flags & LITERAL_ON_HEAP) {
-	    ckfree(bytes);
+	    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);
+	    }
+	    TclVerifyLocalLiteralTable(envPtr);
+#endif /*TCL_COMPILE_DEBUG*/ 
+	    return objIndex;
 	}
-	return NULL;
     }
 
     /*
      * The literal is new to the interpreter. Add it to the global literal
-     * table.
+     * table then add an entry to the CompileEnv's local literal array.
+     * Convert the object to an integer object if possible.
      */
 
     TclNewObj(objPtr);
     Tcl_IncrRefCount(objPtr);
-    if (flags & LITERAL_ON_HEAP) {
+    if (onHeap) {
 	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) {
-	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
-		"TclRegisterLiteral", (length>60? 60 : length), bytes);
+	panic("TclRegisterLiteral: literal \"%.*s\" found globally but shouldn't be",
+	        (length>60? 60 : length), bytes);
     }
 #endif
 
-    globalPtr = ckalloc(sizeof(LiteralEntry));
+    globalPtr = (LiteralEntry *) ckalloc((unsigned) sizeof(LiteralEntry));
     globalPtr->objPtr = objPtr;
-    globalPtr->refCount = 1;
-    globalPtr->nsPtr = nsPtr;
+    globalPtr->refCount = 0;
     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) {
-	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
-		    "TclRegisterLiteral", (length>60? 60 : length), bytes);
+	    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_CMD_NAME then
-				 * the literal should not be shared accross
-				 * namespaces. */
-{
-    Interp *iPtr = envPtr->iPtr;
-    LiteralTable *localTablePtr = &envPtr->localLitTable;
-    LiteralEntry *globalPtr, *localPtr;
-    Tcl_Obj *objPtr;
-    unsigned 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. If it is a command name, avoid
-     * sharing it accross namespaces, and try not to share it with non-cmd
-     * literals. Note that FQ command names can be shared, so that we register
-     * the namespace as the interp's global NS.
-     */
-
-    if (flags & LITERAL_CMD_NAME) {
-	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
-	    nsPtr = iPtr->globalNsPtr;
-	} else {
-	    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("%s: global literal \"%.*s\" had bad refCount %d",
-		"TclRegisterLiteral", (length>60? 60 : length), bytes,
-		globalPtr->refCount);
-    }
-    TclVerifyLocalLiteralTable(envPtr);
-#endif /*TCL_COMPILE_DEBUG*/
     return objIndex;
 }
 
@@ -420,38 +339,38 @@ TclRegisterLiteral(
  * 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(
-    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(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. */
 {
     Interp *iPtr = (Interp *) interp;
-    LiteralTable *globalTablePtr = &iPtr->literalTable;
+    LiteralTable *globalTablePtr = &(iPtr->literalTable);
     register LiteralEntry *entryPtr;
-    const char *bytes;
+    char *bytes;
     int length, globalHash;
 
-    bytes = TclGetStringFromObj(objPtr, &length);
+    bytes = Tcl_GetStringFromObj(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;
 }
@@ -461,10 +380,10 @@ TclLookupLiteralEntry(
  *
  * 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.
@@ -477,27 +396,27 @@ TclLookupLiteralEntry(
  */
 
 void
-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. */
+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. */
 {
     LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
-    LiteralTable *localTablePtr = &envPtr->localLitTable;
+    LiteralTable *localTablePtr = &(envPtr->localLitTable);
     int localHash, length;
-    const char *bytes;
+    char *bytes;
     Tcl_Obj *newObjPtr;
 
-    lPtr = &envPtr->literalArrayPtr[index];
+    lPtr = &(envPtr->literalArrayPtr[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);
@@ -505,11 +424,11 @@ TclHideLiteral(
     TclReleaseLiteral(interp, lPtr->objPtr);
     lPtr->objPtr = newObjPtr;
 
-    bytes = TclGetStringFromObj(newObjPtr, &length);
+    bytes = Tcl_GetStringFromObj(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;
@@ -525,30 +444,31 @@ TclHideLiteral(
  *
  * 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(
-    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(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. */
 {
     register LiteralEntry *lPtr;
     int objIndex;
@@ -559,7 +479,7 @@ TclAddLiteralObj(
     objIndex = envPtr->literalArrayNext;
     envPtr->literalArrayNext++;
 
-    lPtr = &envPtr->literalArrayPtr[objIndex];
+    lPtr = &(envPtr->literalArrayPtr[objIndex]);
     lPtr->objPtr = objPtr;
     Tcl_IncrRefCount(objPtr);
     lPtr->refCount = -1;	/* i.e., unused */
@@ -584,24 +504,27 @@ TclAddLiteralObj(
  *	literal.
  *
  * Side effects:
- *	Expands the literal array if necessary. May rebuild the hash bucket
- *	array of the CompileEnv's literal array if it becomes too large.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-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. */
+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. */
 {
-    register LiteralTable *localTablePtr = &envPtr->localLitTable;
+    register LiteralTable *localTablePtr = &(envPtr->localLitTable);
     LiteralEntry *localPtr;
     int objIndex;
-
-    objIndex = TclAddLiteralObj(envPtr, objPtr, &localPtr);
+    
+    objIndex = TclAddLiteralObj(envPtr, globalPtr->objPtr, &localPtr);
 
     /*
      * Add the literal to the local table.
@@ -611,6 +534,8 @@ AddLocalLiteralEntry(
     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.
@@ -625,25 +550,22 @@ AddLocalLiteralEntry(
     {
 	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 == objPtr) {
+	for (i = 0;  i < localTablePtr->numBuckets;  i++) {
+	    for (localPtr = localTablePtr->buckets[i];
+		    localPtr != NULL;  localPtr = localPtr->nextPtr) {
+		if (localPtr->objPtr == globalPtr->objPtr) {
 		    found = 1;
 		}
 	    }
 	}
-
 	if (!found) {
-	    bytes = Tcl_GetStringFromObj(objPtr, &length);
-	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
-		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
+	    bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+	    panic("AddLocalLiteralEntry: literal \"%.*s\" wasn't found locally",
+	            (length>60? 60 : length), bytes);
 	}
     }
 #endif /*TCL_COMPILE_DEBUG*/
-
     return objIndex;
 }
 
@@ -652,72 +574,72 @@ AddLocalLiteralEntry(
  *
  * ExpandLocalLiteralArray --
  *
- *	Function that uses malloc to allocate more storage for a CompileEnv's
- *	local literal array.
+ *	Procedure 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(
-    register CompileEnv *envPtr)/* Points to the CompileEnv whose object array
-				 * must be enlarged. */
+ExpandLocalLiteralArray(envPtr)
+    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;
+    LiteralTable *localTablePtr = &(envPtr->localLitTable);
     int currElems = envPtr->literalArrayNext;
     size_t currBytes = (currElems * sizeof(LiteralEntry));
-    LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
-    LiteralEntry *newArrayPtr;
+    register LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
+    register LiteralEntry *newArrayPtr =
+	    (LiteralEntry *) ckalloc((unsigned) (2 * currBytes));
     int i;
-
-    if (envPtr->mallocedLiteralArray) {
-	newArrayPtr = ckrealloc(currArrayPtr, 2 * currBytes);
-    } else {
-	/*
-	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
-	 * code a ckrealloc equivalent for ourselves.
-	 */
-
-	newArrayPtr = ckalloc(2 * currBytes);
-	memcpy(newArrayPtr, currArrayPtr, currBytes);
-	envPtr->mallocedLiteralArray = 1;
-    }
-
+    
     /*
-     * Update the local literal table's bucket array.
+     * Copy from the old literal array to the new, then update the local
+     * literal table's bucket array.
      */
 
-    if (currArrayPtr != newArrayPtr) {
-	for (i=0 ; i<currElems ; i++) {
-	    if (newArrayPtr[i].nextPtr != NULL) {
-		newArrayPtr[i].nextPtr = newArrayPtr
-			+ (newArrayPtr[i].nextPtr - currArrayPtr);
-	    }
+    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);
 	}
-	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;
 }
 
 /*
@@ -725,67 +647,86 @@ ExpandLocalLiteralArray(
  *
  * TclReleaseLiteral --
  *
- *	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
+ *	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
  *	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(
-    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(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
 				 * previously created by a call to
 				 * TclRegisterLiteral. */
 {
     Interp *iPtr = (Interp *) interp;
-    LiteralTable *globalTablePtr = &iPtr->literalTable;
+    LiteralTable *globalTablePtr = &(iPtr->literalTable);
     register LiteralEntry *entryPtr, *prevPtr;
-    const char *bytes;
+    ByteCode* codePtr;
+    char *bytes;
     int length, index;
 
-    bytes = TclGetStringFromObj(objPtr, &length);
+    bytes = Tcl_GetStringFromObj(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;
 		} else {
 		    prevPtr->nextPtr = entryPtr->nextPtr;
 		}
-		ckfree(entryPtr);
+		ckfree((char *) entryPtr);
 		globalTablePtr->numEntries--;
 
 		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*/
@@ -793,9 +734,10 @@ TclReleaseLiteral(
 	    break;
 	}
     }
-
+    
     /*
-     * Remove the reference corresponding to the local literal table entry.
+     * Remove the reference corresponding to the local literal table
+     * entry.
      */
 
     Tcl_DecrRefCount(objPtr);
@@ -806,11 +748,12 @@ TclReleaseLiteral(
  *
  * 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.
@@ -818,48 +761,34 @@ TclReleaseLiteral(
  *----------------------------------------------------------------------
  */
 
-static unsigned
-HashString(
-    register const char *string,	/* String for which to compute hash value. */
-    int length)			/* Number of bytes in the string. */
+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. */
 {
-    register unsigned int result = 0;
+    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:
-     *
-     * 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.
+     * 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:
      *
-     * Note that this function is very weak against malicious strings; it's
-     * very easy to generate multiple keys that have the same hashcode. On the
-     * other hand, that hardly ever actually occurs and this function *is*
-     * very cheap, even by comparison with industry-standard hashes like FNV.
-     * If real strength of hash is required though, use a custom hash based on
-     * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
-     * Tcl scripts tend to not have a big issue in this area, and literals
-     * mostly aren't looked up by name anyway.
-     *
-     * See also HashStringKey in tclHash.c.
-     * See also TclObjHashKey in tclObj.c.
-     *
-     * See [tcl-Feature Request #2958832]
+     * 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.
      */
 
-    if (length > 0) {
-	result = UCHAR(*string);
-	while (--length) {
-	    result += (result << 3) + UCHAR(*++string);
-	}
+    result = 0;
+    for (i = 0;  i < length;  i++) {
+	result += (result<<3) + *bytes++;
     }
     return result;
 }
@@ -869,9 +798,9 @@ HashString(
  *
  * RebuildLiteralTable --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -883,29 +812,30 @@ HashString(
  */
 
 static void
-RebuildLiteralTable(
-    register LiteralTable *tablePtr)
-				/* Local or global table to enlarge. */
+RebuildLiteralTable(tablePtr)
+    register LiteralTable *tablePtr; /* Local or global table to enlarge. */
 {
     LiteralEntry **oldBuckets;
     register LiteralEntry **oldChainPtr, **newChainPtr;
     register LiteralEntry *entryPtr;
     LiteralEntry **bucketPtr;
-    const char *bytes;
+    char *bytes;
     int oldSize, count, index, length;
 
     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 = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
-    for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
-	    count>0 ; count--, newChainPtr++) {
+    tablePtr->buckets = (LiteralEntry **) ckalloc((unsigned)
+	    (tablePtr->numBuckets * sizeof(LiteralEntry *)));
+    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
+	    count > 0;
+	    count--, newChainPtr++) {
 	*newChainPtr = NULL;
     }
     tablePtr->rebuildSize *= 4;
@@ -915,13 +845,16 @@ RebuildLiteralTable(
      * 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 = TclGetStringFromObj(entryPtr->objPtr, &length);
+    for (oldChainPtr = oldBuckets;
+	    oldSize > 0;
+	    oldSize--, oldChainPtr++) {
+	for (entryPtr = *oldChainPtr;  entryPtr != NULL;
+	        entryPtr = *oldChainPtr) {
+	    bytes = Tcl_GetStringFromObj(entryPtr->objPtr, &length);
 	    index = (HashString(bytes, length) & tablePtr->mask);
-
+	    
 	    *oldChainPtr = entryPtr->nextPtr;
-	    bucketPtr = &tablePtr->buckets[index];
+	    bucketPtr = &(tablePtr->buckets[index]);
 	    entryPtr->nextPtr = *bucketPtr;
 	    *bucketPtr = entryPtr;
 	}
@@ -932,47 +865,7 @@ RebuildLiteralTable(
      */
 
     if (oldBuckets != tablePtr->staticBuckets) {
-	ckfree(oldBuckets);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInvalidateCmdLiteral --
- *
- *	Invalidate a command literal entry, if present in the literal hash
- *	tables, by resetting its internal representation. This invalidation
- *	leaves it in the literal tables and in existing literal arrays. As a
- *	result, existing references continue to work but we force a fresh
- *	command look-up upon the next use (see, in particular,
- *	TclSetCmdNameObj()).
- *
- * Results:
- *	None.
- *
- * Side effects: 
- *	Resets the internal representation of the CmdName Tcl_Obj
- *	using TclFreeIntRep().
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclInvalidateCmdLiteral(
-    Tcl_Interp *interp,		/* Interpreter for which to invalidate a
-				 * command literal. */
-    const char *name,		/* Points to the start of the cmd literal
-				 * name. */
-    Namespace *nsPtr)		/* The namespace for which to lookup and
-				 * invalidate a cmd literal. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, (char *) name,
-	    strlen(name), -1, NULL, nsPtr, 0, NULL);
-
-    if (literalObjPtr != NULL && literalObjPtr->typePtr == &tclCmdNameType) {
-	TclFreeIntRep(literalObjPtr);
+	ckfree((char *) oldBuckets);
     }
 }
 
@@ -982,12 +875,13 @@ TclInvalidateCmdLiteral(
  *
  * 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.
@@ -996,8 +890,8 @@ TclInvalidateCmdLiteral(
  */
 
 char *
-TclLiteralStats(
-    LiteralTable *tablePtr)	/* Table for which to produce stats. */
+TclLiteralStats(tablePtr)
+    LiteralTable *tablePtr;	/* Table for which to produce stats. */
 {
 #define NUM_COUNTERS 10
     int count[NUM_COUNTERS], overflow, i, j;
@@ -1006,19 +900,19 @@ TclLiteralStats(
     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) {
@@ -1034,11 +928,11 @@ TclLiteralStats(
      * Print out the histogram and a few other pieces of information.
      */
 
-    result = ckalloc(NUM_COUNTERS*60 + 300);
+    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);
-    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);
@@ -1063,50 +957,47 @@ TclLiteralStats(
  *	None.
  *
  * Side effects:
- *	Tcl_Panic if problems are found.
+ *	Panics if problems are found.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclVerifyLocalLiteralTable(
-    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
-				 * to be validated. */
+TclVerifyLocalLiteralTable(envPtr)
+    CompileEnv *envPtr;		/* Points to CompileEnv whose literal
+				 * table is to be validated. */
 {
-    register LiteralTable *localTablePtr = &envPtr->localLitTable;
+    register LiteralTable *localTablePtr = &(envPtr->localLitTable);
     register LiteralEntry *localPtr;
     char *bytes;
     register int i;
     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);
-		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
-			"TclVerifyLocalLiteralTable",
-			(length>60? 60 : length), bytes, localPtr->refCount);
+		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);
-		Tcl_Panic("%s: local literal \"%.*s\" is not global",
-			"TclVerifyLocalLiteralTable",
-			(length>60? 60 : length), bytes);
+		panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global",
+		         (length>60? 60 : length), bytes);
 	    }
 	    if (localPtr->objPtr->bytes == NULL) {
-		Tcl_Panic("%s: literal has NULL string rep",
-			"TclVerifyLocalLiteralTable");
+		panic("TclVerifyLocalLiteralTable: literal has NULL string rep");
 	    }
 	}
     }
     if (count != localTablePtr->numEntries) {
-	Tcl_Panic("%s: local literal table had %d entries, should be %d",
-		"TclVerifyLocalLiteralTable", count,
-		localTablePtr->numEntries);
+	panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d",
+	      count, localTablePtr->numEntries);
     }
 }
 
@@ -1121,51 +1012,41 @@ TclVerifyLocalLiteralTable(
  *	None.
  *
  * Side effects:
- *	Tcl_Panic if problems are found.
+ *	Panics if problems are found.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclVerifyGlobalLiteralTable(
-    Interp *iPtr)		/* Points to interpreter whose global literal
-				 * table is to be validated. */
+TclVerifyGlobalLiteralTable(iPtr)
+    Interp *iPtr;		/* Points to interpreter whose global
+				 * literal table is to be validated. */
 {
-    register LiteralTable *globalTablePtr = &iPtr->literalTable;
+    register LiteralTable *globalTablePtr = &(iPtr->literalTable);
     register LiteralEntry *globalPtr;
     char *bytes;
     register int i;
     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);
-		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
-			"TclVerifyGlobalLiteralTable",
-			(length>60? 60 : length), bytes, globalPtr->refCount);
+		panic("TclVerifyGlobalLiteralTable: global literal \"%.*s\" had bad refCount %d",
+		        (length>60? 60 : length), bytes,
+		        globalPtr->refCount);
 	    }
 	    if (globalPtr->objPtr->bytes == NULL) {
-		Tcl_Panic("%s: literal has NULL string rep",
-			"TclVerifyGlobalLiteralTable");
+		panic("TclVerifyGlobalLiteralTable: literal has NULL string rep");
 	    }
 	}
     }
     if (count != globalTablePtr->numEntries) {
-	Tcl_Panic("%s: global literal table had %d entries, should be %d",
-		"TclVerifyGlobalLiteralTable", count,
-		globalTablePtr->numEntries);
+	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 008a99d..0caa28b 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -1,64 +1,59 @@
-/*
+/* 
  * 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 function to call to
+				/* Initialization procedure to call to
 				 * incorporate this package into a trusted
 				 * interpreter. */
     Tcl_PackageInitProc *safeInitProc;
-				/* Initialization function to call to
+				/* Initialization 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 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. */
+				 * untrusted scripts).   NULL means the
+				 * package can't be used in unsafe
+				 * 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. */
     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;
 
 /*
@@ -74,35 +69,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
- * 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).
+ * 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).
  */
 
 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 functions that are private to this file:
+ * Prototypes for procedures that are private to this file:
  */
 
-static void		LoadCleanupProc(ClientData clientData,
-			    Tcl_Interp *interp);
+static void		LoadCleanupProc _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp));
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_LoadObjCmd --
  *
- *	This function is invoked to process the "load" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "load" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -114,39 +109,36 @@ static void		LoadCleanupProc(ClientData clientData,
  */
 
 int
-Tcl_LoadObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Interp *target;
     LoadedPackage *pkgPtr, *defaultPtr;
     Tcl_DString pkgName, tmp, initName, safeInitName;
-    Tcl_DString unloadName, safeUnloadName;
+    Tcl_PackageInitProc *initProc, *safeInitProc;
     InterpPackage *ipFirstPtr, *ipPtr;
-    int code, namesMatch, filesMatch, offset;
-    const char *symbols[2];
-    Tcl_PackageInitProc *initProc;
-    const char *p, *fullFileName, *packageName;
+    int code, namesMatch, filesMatch;
+    char *p, *fullFileName, *packageName;
     Tcl_LoadHandle loadHandle;
+    Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
     Tcl_UniChar ch;
-    unsigned len;
+    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;
@@ -160,8 +152,6 @@ Tcl_LoadObjCmd(
 	Tcl_SetResult(interp,
 		"must specify either file name or package name",
 		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
-		NULL);
 	code = TCL_ERROR;
 	goto done;
     }
@@ -172,25 +162,23 @@ Tcl_LoadObjCmd(
 
     target = interp;
     if (objc == 4) {
-	const char *slaveIntName = Tcl_GetString(objv[3]);
-
+	char *slaveIntName;
+	slaveIntName = Tcl_GetString(objv[3]);
 	target = Tcl_GetSlave(interp, slaveIntName);
 	if (target == NULL) {
-	    code = TCL_ERROR;
-	    goto done;
+	    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:
+     * 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;
@@ -222,14 +210,13 @@ Tcl_LoadObjCmd(
 	}
 	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, "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
-		    "SPLITPERSONALITY", NULL);
+		    pkgPtr->packageName, "\"", (char *) NULL);
 	    code = TCL_ERROR;
 	    Tcl_MutexUnlock(&packageMutex);
 	    goto done;
@@ -242,12 +229,13 @@ Tcl_LoadObjCmd(
 
     /*
      * 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 do.
+     * interpreter.  If the package we want is already loaded there,
+     * then there's nothing for us to to.
      */
 
     if (pkgPtr != NULL) {
-	ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+		(Tcl_InterpDeleteProc **) NULL);
 	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	    if (ipPtr->pkgPtr == pkgPtr) {
 		code = TCL_OK;
@@ -258,15 +246,13 @@ Tcl_LoadObjCmd(
 
     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", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
-		    NULL);
+		    "\" isn't loaded statically", (char *) NULL);
 	    code = TCL_ERROR;
 	    goto done;
 	}
@@ -279,23 +265,22 @@ Tcl_LoadObjCmd(
 	    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, *pkgGuessPtr;
+		Tcl_Obj *splitPtr;
+		Tcl_Obj *pkgGuessPtr;
 		int pElements;
-		const char *pkgGuess;
+		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);
@@ -323,9 +308,7 @@ Tcl_LoadObjCmd(
 		    Tcl_DecrRefCount(splitPtr);
 		    Tcl_AppendResult(interp,
 			    "couldn't figure out package name for ",
-			    fullFileName, NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
-			    "WHATPACKAGE", NULL);
+			    fullFileName, (char *) NULL);
 		    code = TCL_ERROR;
 		    goto done;
 		}
@@ -339,544 +322,112 @@ Tcl_LoadObjCmd(
 	 * 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 functions, based on the
-	 * package name.
+	 * Compute the names of the two initialization procedures,
+	 * 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 functions.
+	 * Call platform-specific code to load the package and find the
+	 * two initialization procedures.
 	 */
 
-	symbols[0] = Tcl_DStringValue(&initName);
-	symbols[1] = NULL;
-
 	Tcl_MutexLock(&packageMutex);
-	code = Tcl_LoadFile(interp, objv[1], symbols, 0, &initProc,
-		&loadHandle);
+	code = Tcl_FSLoadFile(interp, objv[1], Tcl_DStringValue(&initName),
+		Tcl_DStringValue(&safeInitName), &initProc, &safeInitProc,
+		&loadHandle,&unLoadProcPtr);
 	Tcl_MutexUnlock(&packageMutex);
 	if (code != TCL_OK) {
 	    goto done;
 	}
+	if (initProc == NULL) {
+	    Tcl_AppendResult(interp, "couldn't find procedure ",
+		    Tcl_DStringValue(&initName), (char *) NULL);
+	    if (unLoadProcPtr != NULL) {
+		(*unLoadProcPtr)(loadHandle);
+	    }
+	    code = TCL_ERROR;
+	    goto done;
+	}
 
 	/*
 	 * Create a new record to describe this package.
 	 */
 
-	pkgPtr = ckalloc(sizeof(LoadedPackage));
-	len = strlen(fullFileName) + 1;
-	pkgPtr->fileName	   = ckalloc(len);
-	memcpy(pkgPtr->fileName, fullFileName, len);
-	len = (unsigned) Tcl_DStringLength(&pkgName) + 1;
-	pkgPtr->packageName	   = ckalloc(len);
-	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
-	pkgPtr->loadHandle	   = loadHandle;
-	pkgPtr->initProc	   = initProc;
-	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
-		Tcl_FindSymbol(interp, loadHandle,
-			Tcl_DStringValue(&safeInitName));
-	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
-		Tcl_FindSymbol(interp, loadHandle,
-			Tcl_DStringValue(&unloadName));
-	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *) 
-		Tcl_FindSymbol(interp, loadHandle,
-			Tcl_DStringValue(&safeUnloadName));
-	pkgPtr->interpRefCount	   = 0;
-	pkgPtr->safeInterpRefCount = 0;
-
+	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
+	pkgPtr->fileName	= (char *) ckalloc((unsigned)
+		(strlen(fullFileName) + 1));
+	strcpy(pkgPtr->fileName, fullFileName);
+	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;
 	Tcl_MutexLock(&packageMutex);
-	pkgPtr->nextPtr		   = firstPackagePtr;
-	firstPackagePtr		   = pkgPtr;
+	pkgPtr->nextPtr		= firstPackagePtr;
+	firstPackagePtr		= pkgPtr;
 	Tcl_MutexUnlock(&packageMutex);
-
-	/*
-	 * The Tcl_FindSymbol calls may have left a spurious error message in
-	 * the interpreter result.
-	 */
-
-	Tcl_ResetResult(interp);
-    }
-
-    /*
-     * 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)) {
-	if (pkgPtr->safeInitProc == NULL) {
-	    Tcl_AppendResult(interp,
-		    "can't use package in a safe interpreter: no ",
-		    pkgPtr->packageName, "_SafeInit procedure", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
-		    NULL);
-	    code = TCL_ERROR;
-	    goto done;
-	}
-	code = pkgPtr->safeInitProc(target);
-    } else {
-	if (pkgPtr->initProc == NULL) {
-	    Tcl_AppendResult(interp,
-		    "can't attach package to interpreter: no ",
-		    pkgPtr->packageName, "_Init procedure", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
-		    NULL);
-	    code = TCL_ERROR;
-	    goto done;
-	}
-	code = pkgPtr->initProc(target);
-    }
-
-    /*
-     * Test for whether the initialization failed. If so, transfer the error
-     * from the target interpreter to the originating one.
-     */
-
-    if (code != TCL_OK) {
-	Tcl_TransferResult(target, code, interp);
-	goto done;
     }
 
     /*
-     * Record the fact that the package has been loaded in the target
-     * interpreter.
-     *
-     * Update the proper reference count.
+     * Invoke the package's initialization procedure (either the
+     * normal one or the safe one, depending on whether or not the
+     * interpreter is safe).
      */
 
-    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 = Tcl_GetAssocData(target, "tclLoad", NULL);
-    ipPtr = ckalloc(sizeof(InterpPackage));
-    ipPtr->pkgPtr = pkgPtr;
-    ipPtr->nextPtr = ipFirstPtr;
-    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
-
-  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 = "";
-    const char *packageName;
-    static const char *const 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,
-		"?-switch ...? 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);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
-		NULL);
-	code = TCL_ERROR;
-	goto done;
-    }
-
-    /*
-     * Figure out which interpreter we're going to load the package into.
-     */
-
-    target = interp;
-    if (objc - i == 3) {
-	const char *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;
+	if (pkgPtr->safeInitProc != NULL) {
+	    code = (*pkgPtr->safeInitProc)(target);
 	} 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);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
-		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);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
-		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 = 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);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
-		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);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
-		    NULL);
+	    Tcl_AppendResult(interp,
+		    "can't use package in a safe interpreter: ",
+		    "no ", pkgPtr->packageName, "_SafeInit procedure",
+		    (char *) 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);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
-		    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) {
-	Tcl_TransferResult(target, code, interp);
-	goto done;
+	code = (*pkgPtr->initProc)(target);
     }
 
     /*
-     * The unload function executed fine. Examine the reference count to see
-     * if we unload the DLL.
+     * Record the fact that the package has been loaded in the
+     * target interpreter.
      */
 
-    Tcl_MutexLock(&packageMutex);
-    if (Tcl_IsSafe(target)) {
-	pkgPtr->safeInterpRefCount--;
-
+    if (code == TCL_OK) {
 	/*
-	 * Do not let counter get negative.
+	 * Refetch ipFirstPtr: loading the package may have introduced
+	 * additional static packages at the head of the linked list!
 	 */
 
-	if (pkgPtr->safeInterpRefCount < 0) {
-	    pkgPtr->safeInterpRefCount = 0;
-	}
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+		(Tcl_InterpDeleteProc **) NULL);
+	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
+	ipPtr->pkgPtr = pkgPtr;
+	ipPtr->nextPtr = ipFirstPtr;
+	Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
+		(ClientData) ipPtr);
     } 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_MutexLock(&packageMutex);
-	    if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
-		/*
-		 * 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 = 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,
-			ipFirstPtr);
-		ckfree(defaultPtr->fileName);
-		ckfree(defaultPtr->packageName);
-		ckfree(defaultPtr);
-		ckfree(ipPtr);
-		Tcl_MutexUnlock(&packageMutex);
-	    } else {
-		code = TCL_ERROR;
-	    }
-	}
-#else
-	Tcl_AppendResult(interp, "file \"", fullFileName,
-		"\" cannot be unloaded: unloading disabled", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
-		NULL);
-	code = TCL_ERROR;
-#endif
+	TclTransferResult(target, code, interp);
     }
 
-  done:
+    done:
     Tcl_DStringFree(&pkgName);
+    Tcl_DStringFree(&initName);
+    Tcl_DStringFree(&safeInitName);
     Tcl_DStringFree(&tmp);
-    if (!complain && (code != TCL_OK)) {
-	code = TCL_OK;
-	Tcl_ResetResult(interp);
-    }
     return code;
 }
 
@@ -885,37 +436,37 @@ Tcl_UnloadObjCmd(
  *
  * Tcl_StaticPackage --
  *
- *	This function is invoked to indicate that a particular package has
- *	been linked statically with an application.
+ *	This procedure is invoked to indicate that a particular
+ *	package has been linked statically with an application.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Once this function completes, the package becomes loadable via the
- *	"load" command with an empty file name.
+ *	Once this procedure completes, the package becomes loadable
+ *	via the "load" command with an empty file name.
  *
  *----------------------------------------------------------------------
  */
 
 void
-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. */
+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. */
 {
     LoadedPackage *pkgPtr;
     InterpPackage *ipPtr, *ipFirstPtr;
@@ -936,15 +487,16 @@ Tcl_StaticPackage(
     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 = ckalloc(sizeof(LoadedPackage));
-	pkgPtr->fileName	= ckalloc(1);
+    if ( pkgPtr == NULL ) {
+	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
+	pkgPtr->fileName	= (char *) ckalloc((unsigned) 1);
 	pkgPtr->fileName[0]	= 0;
-	pkgPtr->packageName	= ckalloc(strlen(pkgName) + 1);
+	pkgPtr->packageName	= (char *) ckalloc((unsigned)
+						   (strlen(pkgName) + 1));
 	strcpy(pkgPtr->packageName, pkgName);
 	pkgPtr->loadHandle	= NULL;
 	pkgPtr->initProc	= initProc;
@@ -958,26 +510,28 @@ Tcl_StaticPackage(
     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 = Tcl_GetAssocData(interp, "tclLoad", NULL);
-	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
-	    if (ipPtr->pkgPtr == pkgPtr) {
+	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp, "tclLoad",
+		(Tcl_InterpDeleteProc **) NULL);
+	for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) {
+	    if ( ipPtr->pkgPtr == pkgPtr ) {
 		return;
 	    }
 	}
 
 	/*
-	 * 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 = ckalloc(sizeof(InterpPackage));
+	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
 	ipPtr->pkgPtr = pkgPtr;
 	ipPtr->nextPtr = ipFirstPtr;
-	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
+	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc,
+		(ClientData) ipPtr);
     }
 }
 
@@ -986,15 +540,17 @@ Tcl_StaticPackage(
  *
  * TclGetLoadedPackages --
  *
- *	This function returns information about all of the files that are
- *	loaded (either in a particular intepreter, or for all interpreters).
+ *	This procedure 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.
@@ -1003,56 +559,58 @@ Tcl_StaticPackage(
  */
 
 int
-TclGetLoadedPackages(
-    Tcl_Interp *interp,		/* Interpreter in which to return information
-				 * or error message. */
-    const char *targetName)	/* Name of target interpreter or NULL. If
-				 * NULL, return info about all interps;
+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;
 				 * otherwise, just return info about this
 				 * interpreter. */
 {
     Tcl_Interp *target;
     LoadedPackage *pkgPtr;
     InterpPackage *ipPtr;
-    Tcl_Obj *resultObj, *pkgDesc[2];
+    char *prefix;
 
     if (targetName == NULL) {
-	/*
+	/* 
 	 * Return information about all of the available packages.
 	 */
 
-	resultObj = Tcl_NewObj();
+	prefix = "{";
 	Tcl_MutexLock(&packageMutex);
 	for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
 		pkgPtr = pkgPtr->nextPtr) {
-	    pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
-	    pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewListObj(2, pkgDesc));
+	    Tcl_AppendResult(interp, prefix, (char *) NULL);
+	    Tcl_AppendElement(interp, pkgPtr->fileName);
+	    Tcl_AppendElement(interp, pkgPtr->packageName);
+	    Tcl_AppendResult(interp, "}", (char *) NULL);
+	    prefix = " {";
 	}
 	Tcl_MutexUnlock(&packageMutex);
-	Tcl_SetObjResult(interp, resultObj);
 	return TCL_OK;
     }
 
     /*
-     * 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 = Tcl_GetAssocData(target, "tclLoad", NULL);
-    resultObj = Tcl_NewObj();
-    for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+    ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+	    (Tcl_InterpDeleteProc **) NULL);
+    prefix = "{";
+    for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
 	pkgPtr = ipPtr->pkgPtr;
-	pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
-	pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
-	Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
+	Tcl_AppendResult(interp, prefix, (char *) NULL);
+	Tcl_AppendElement(interp, pkgPtr->fileName);
+	Tcl_AppendElement(interp, pkgPtr->packageName);
+	Tcl_AppendResult(interp, "}", (char *) NULL);
+	prefix = " {";
     }
-    Tcl_SetObjResult(interp, resultObj);
     return TCL_OK;
 }
 
@@ -1061,31 +619,32 @@ TclGetLoadedPackages(
  *
  * LoadCleanupProc --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Storage for all of the InterpPackage functions for interp get deleted.
+ *	Storage for all of the InterpPackage procedures for interp
+ *	get deleted.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-LoadCleanupProc(
-    ClientData clientData,	/* Pointer to first InterpPackage structure
+LoadCleanupProc(clientData, interp)
+    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;
 
-    ipPtr = clientData;
+    ipPtr = (InterpPackage *) clientData;
     while (ipPtr != NULL) {
 	nextPtr = ipPtr->nextPtr;
-	ckfree(ipPtr);
+	ckfree((char *) ipPtr);
 	ipPtr = nextPtr;
     }
 }
@@ -1095,8 +654,8 @@ LoadCleanupProc(
  *
  * TclFinalizeLoad --
  *
- *	This function is invoked just before the application exits. It frees
- *	all of the LoadedPackage structures.
+ *	This procedure is invoked just before the application exits.
+ *	It frees all of the LoadedPackage structures.
  *
  * Results:
  *	None.
@@ -1108,44 +667,38 @@ LoadCleanupProc(
  */
 
 void
-TclFinalizeLoad(void)
+TclFinalizeLoad()
 {
     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 has 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's been unloaded.
 	 */
-
 	if (pkgPtr->fileName[0] != '\0') {
-	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
+	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
+	    if (unLoadProcPtr != NULL) {
+	        (*unLoadProcPtr)(pkgPtr->loadHandle);
+	    }
 	}
 #endif
-
 	ckfree(pkgPtr->fileName);
 	ckfree(pkgPtr->packageName);
-	ckfree(pkgPtr);
+	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 ac094e6..4f795aa 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -1,13 +1,14 @@
-/*
+/* 
  * tclLoadNone.c --
  *
- *	This procedure provides a version of the TclpDlopen 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"
@@ -17,13 +18,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.
@@ -32,17 +33,17 @@
  */
 
 int
-TclpDlopen(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
+TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
+    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",
@@ -53,16 +54,40 @@ TclpDlopen(
 /*
  *----------------------------------------------------------------------
  *
+ * TclpFindSymbol --
+ *
+ *	Looks up a symbol, by name, through a handle associated with
+ *	a previously loaded piece of code (shared library).
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_PackageInitProc*
+TclpFindSymbol(interp, loadHandle, symbol) 
+    Tcl_Interp *interp;
+    Tcl_LoadHandle loadHandle;
+    CONST char *symbol;
+{
+    return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * 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.
@@ -71,19 +96,38 @@ TclpDlopen(
  */
 
 int
-TclGuessPackageName(
-    const char *fileName,	/* Name of file containing package (already
+TclGuessPackageName(fileName, bufPtr)
+    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;
 }
 
 /*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
+ *----------------------------------------------------------------------
+ *
+ * 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).
+ *
+ * Results:
+ *    None.
+ *
+ * Side effects:
+ *    None.
+ *
+ *----------------------------------------------------------------------
  */
+
+void
+TclpUnloadFile(loadHandle)
+    Tcl_LoadHandle loadHandle;	/* loadHandle returned by a previous call
+				 * to TclpDlopen().  The loadHandle is 
+				 * a token that represents the loaded 
+				 * file. */
+{
+}
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 88b4e51..8252170 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -1,429 +1,309 @@
-/*
+/* 
  * tclMain.c --
  *
  *	Main program for Tcl shells and other Tcl-based applications.
- *	This file contains a generic main program for Tcl shells and other
- *	Tcl-based applications. It can be used as-is for many applications,
- *	just by supplying a different appInitProc function for each specific
- *	application. Or, it can be used as a template for creating new main
- *	programs for Tcl applications.
  *
  * Copyright (c) 1988-1994 The Regents of the University of California.
  * 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.
- */
-
-/**
- * On Windows, this file needs to be compiled twice, once with
- * TCL_ASCII_MAIN defined. This way both Tcl_Main and Tcl_MainExW
- * can be implemented, sharing the same source code.
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
-#if defined(TCL_ASCII_MAIN)
-#   ifdef UNICODE
-#	undef UNICODE
-#	undef _UNICODE
-#   else
-#	define UNICODE
-#	define _UNICODE
-#   endif
-#endif
 
+#include "tcl.h"
 #include "tclInt.h"
 
-/*
- * The default prompt used when the user has not overridden it.
- */
-
-#define DEFAULT_PRIMARY_PROMPT	"% "
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
 
 /*
- * This file can be compiled on Windows in UNICODE mode, as well as
- * on all other platforms using the native encoding. This is done
- * by using the normal Windows functions like _tcscmp, but on
- * platforms which don't have <tchar.h> we have to translate that
- * to strcmp here.
+ * 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).
  */
-#ifndef __WIN32__
-#   define TCHAR char
-#   define TEXT(arg) arg
-#   define _tcscmp strcmp
-#endif
-
-/*
- * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
- * NewNativeObj is needed (which provides proper conversion from native
- * encoding to UTF-8).
- */
-
-#ifdef UNICODE
-#   define NewNativeObj Tcl_NewUnicodeObj
-#else /* !UNICODE */
-static inline Tcl_Obj *
-NewNativeObj(
-    char *string,
-    int length)
-{
-    Tcl_DString ds;
 
-    Tcl_ExternalToUtfDString(NULL, string, length, &ds);
-    return TclDStringToObj(&ds);
-}
-#endif /* !UNICODE */
-
-/*
- * 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);
+#if !defined(MAC_TCL)
+extern int		isatty _ANSI_ARGS_((int fd));
+#else
+#include <unistd.h>
+#endif
 
-/*
- * The thread-local variables for this file's functions.
- */
+static Tcl_Obj *tclStartupScriptPath = NULL;
 
-typedef struct {
-    Tcl_Obj *path;		/* The filename of the script for *_Main()
-				 * routines to [source] as a startup script,
-				 * or NULL for none set, meaning enter
-				 * interactive mode. */
-    Tcl_Obj *encoding;		/* The encoding of the startup script file. */
-    Tcl_MainLoopProc *mainLoopProc;
-				/* Any installed main loop handler. The main
-				 * extension that installs these is Tk. */
-} ThreadSpecificData;
+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 functions defined later in this file.
+ * Forward declarations for procedures defined later in this file.
  */
 
-MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void);
-static void		Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
-static void		StdinProc(ClientData clientData, int mask);
-static void     FreeMainInterp(ClientData clientData);
+static void		Prompt _ANSI_ARGS_((Tcl_Interp *interp,
+			    PromptType *promptPtr));
+static void		StdinProc _ANSI_ARGS_((ClientData clientData,
+			    int mask));
+
 
-#ifndef TCL_ASCII_MAIN
-static Tcl_ThreadDataKey dataKey;
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_SetStartupScript --
+ * TclSetStartupScriptPath --
  *
- *	Sets the path and encoding of the startup script to be evaluated by
- *	Tcl_Main, used to override the command line processing.
+ *	Primes the startup script VFS path, 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
-Tcl_SetStartupScript(
-    Tcl_Obj *path,		/* Filesystem path of startup script file */
-    const char *encoding)	/* Encoding of the data in that file */
+void TclSetStartupScriptPath(pathPtr)
+    Tcl_Obj *pathPtr;
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    Tcl_Obj *newEncoding = NULL;
-
-    if (encoding != NULL) {
-	newEncoding = Tcl_NewStringObj(encoding, -1);
-    }
-
-    if (tsdPtr->path != NULL) {
-	Tcl_DecrRefCount(tsdPtr->path);
+    if (tclStartupScriptPath != NULL) {
+	Tcl_DecrRefCount(tclStartupScriptPath);
     }
-    tsdPtr->path = path;
-    if (tsdPtr->path != NULL) {
-	Tcl_IncrRefCount(tsdPtr->path);
-    }
-
-    if (tsdPtr->encoding != NULL) {
-	Tcl_DecrRefCount(tsdPtr->encoding);
-    }
-    tsdPtr->encoding = newEncoding;
-    if (tsdPtr->encoding != NULL) {
-	Tcl_IncrRefCount(tsdPtr->encoding);
+    tclStartupScriptPath = pathPtr;
+    if (tclStartupScriptPath != NULL) {
+	Tcl_IncrRefCount(tclStartupScriptPath);
     }
 }
-
+
+
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_GetStartupScript --
+ * TclGetStartupScriptPath --
  *
- *	Gets the path and encoding of the startup script to be evaluated by
- *	Tcl_Main.
+ *	Gets the startup script VFS path, used to override the
+ *      command line processing.
  *
  * Results:
- *	The path of the startup script; NULL if none has been set.
+ *	The startup script VFS path, 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.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
-
-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. */
+Tcl_Obj *TclGetStartupScriptPath()
 {
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    return tclStartupScriptPath;
+}
 
-    if (encodingPtr != NULL) {
-	if (tsdPtr->encoding == NULL) {
-	    *encodingPtr = NULL;
-	} else {
-	    *encodingPtr = Tcl_GetString(tsdPtr->encoding);
-	}
-    }
-    return tsdPtr->path;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetStartupScriptFileName --
+ *
+ *	Primes the startup script file name, used to override the
+ *      command line processing.
+ *
+ * Results:
+ *	None. 
+ *
+ * Side effects:
+ *	This procedure initializes the file name of the Tcl script to
+ *      run at startup.
+ *
+ *----------------------------------------------------------------------
+ */
+void TclSetStartupScriptFileName(fileName)
+    CONST char *fileName;
+{
+    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
+    TclSetStartupScriptPath(pathPtr);
 }
+
 
-/*----------------------------------------------------------------------
+/*
+ *----------------------------------------------------------------------
  *
- * Tcl_SourceRCFile --
+ * TclGetStartupScriptFileName --
  *
- *	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.
+ *	Gets the startup script file name, used to override the
+ *      command line processing.
  *
  * Results:
- *	None.
+ *	The startup script file name, NULL if none has been set.
  *
  * Side effects:
- *	Depends on what's in the rc script.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
-
-void
-Tcl_SourceRCFile(
-    Tcl_Interp *interp)		/* Interpreter to source rc file into. */
+CONST char *TclGetStartupScriptFileName()
 {
-    Tcl_DString temp;
-    const char *fileName;
-    Tcl_Channel chan;
-
-    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.
-	     */
+    Tcl_Obj *pathPtr = TclGetStartupScriptPath();
 
-	    c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
-	    if (c != NULL) {
-		Tcl_Close(NULL, c);
-		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
-		    chan = Tcl_GetStdChannel(TCL_STDERR);
-		    if (chan) {
-			Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
-			Tcl_WriteChars(chan, "\n", 1);
-		    }
-		}
-	    }
-	}
-	Tcl_DStringFree(&temp);
+    if (pathPtr == NULL) {
+	return NULL;
     }
+    return Tcl_GetString(pathPtr);
 }
-#endif /* !TCL_ASCII_MAIN */
+
+
 
-/*----------------------------------------------------------------------
+/*
+ *----------------------------------------------------------------------
  *
- * Tcl_Main, Tcl_MainEx --
+ * Tcl_Main --
  *
  *	Main program for tclsh and most other Tcl-based applications.
  *
  * Results:
- *	None. This function never returns (it exits the process when it's
- *	done).
+ *	None. This procedure never returns (it exits the process when
+ *	it's done).
  *
  * Side effects:
- *	This function initializes the Tcl world and then starts interpreting
- *	commands; almost anything could happen, depending on the script being
- *	interpreted.
+ *	This procedure initializes the Tcl world and then starts
+ *	interpreting commands;  almost anything could happen, depending
+ *	on the script being interpreted.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_MainEx(
-    int argc,			/* Number of arguments. */
-    TCHAR **argv,		/* Array of argument strings. */
-    Tcl_AppInitProc *appInitProc,
+Tcl_Main(argc, argv, appInitProc)
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Array of argument strings. */
+    Tcl_AppInitProc *appInitProc;
 				/* Application-specific initialization
-				 * function to call after most initialization
-				 * but before starting to execute commands. */
-    Tcl_Interp *interp)
+				 * procedure to call after most
+				 * initialization but before starting to
+				 * execute commands. */
 {
-    Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
-    const char *encodingName = NULL;
-    int code, exitCode = 0;
-    Tcl_MainLoopProc *mainLoopProc;
-    Tcl_Channel chan;
-    InteractiveState is;
+    Tcl_Obj *resultPtr, *argvPtr, *commandPtr = 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_InitMemory(interp);
+    Tcl_FindExecutable(argv[0]);
 
-    is.interp = interp;
-    is.prompt = PROMPT_START;
-    is.commandPtr = Tcl_NewObj();
+    interp = Tcl_CreateInterp();
+    Tcl_InitMemory(interp);
 
     /*
-     * If the application has not already set a startup script, parse the
-     * first few command line arguments to determine the script path and
-     * encoding.
+     * 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 (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 == _tcscmp(TEXT("-encoding"), argv[1]))
-		&& (TEXT('-') != argv[3][0])) {
-		Tcl_Obj *value = NewNativeObj(argv[2], -1);
-	    Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value));
-	    Tcl_DecrRefCount(value);
-	    argc -= 3;
-	    argv += 3;
-	} else if ((argc > 1) && (TEXT('-') != argv[1][0])) {
-	    Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
+    if (TclGetStartupScriptPath() == NULL) {
+	if ((argc > 1) && (argv[1][0] != '-')) {
+	    TclSetStartupScriptFileName(argv[1]);
 	    argc--;
 	    argv++;
 	}
     }
 
-    path = Tcl_GetStartupScript(&encodingName);
-    if (path == NULL) {
-	appName = NewNativeObj(argv[0], -1);
+    if (TclGetStartupScriptPath() == NULL) {
+	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
     } else {
-	appName = path;
+	TclSetStartupScriptFileName(Tcl_ExternalToUtfDString(NULL,
+		TclGetStartupScriptFileName(), -1, &appName));
     }
-    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
+    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
+    Tcl_DStringFree(&appName);
     argc--;
     argv++;
 
-    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
-
+    objPtr = Tcl_NewIntObj(argc);
+    Tcl_IncrRefCount(objPtr);
+    Tcl_SetVar2Ex(interp, "argc", NULL, objPtr, TCL_GLOBAL_ONLY);
+    Tcl_DecrRefCount(objPtr);
+    
     argvPtr = Tcl_NewListObj(0, NULL);
     while (argc--) {
-	Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
+	Tcl_DString ds;
+	Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
+	Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
+		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.
      */
 
-    is.tty = isatty(0);
-    Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
-	    Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY);
-
+    tty = isatty(0);
+    Tcl_SetVar(interp, "tcl_interactive",
+	    ((TclGetStartupScriptPath() == NULL) && tty) ? "1" : "0",
+	    TCL_GLOBAL_ONLY);
+    
     /*
      * Invoke application-specific initialization.
      */
 
-    Tcl_Preserve(interp);
-    if (appInitProc(interp) != TCL_OK) {
-	chan = Tcl_GetStdChannel(TCL_STDERR);
-	if (chan) {
-	    Tcl_WriteChars(chan,
+    Tcl_Preserve((ClientData) interp);
+    if ((*appInitProc)(interp) != TCL_OK) {
+	errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	if (errChannel) {
+	    Tcl_WriteChars(errChannel,
 		    "application-specific initialization failed: ", -1);
-	    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
-	    Tcl_WriteChars(chan, "\n", 1);
+	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+	    Tcl_WriteChars(errChannel, "\n", 1);
 	}
     }
     if (Tcl_InterpDeleted(interp)) {
 	goto done;
     }
-    if (Tcl_LimitExceeded(interp)) {
-	goto done;
-    }
-    if (TclFullFinalizationRequested()) {
-	/*
-	 * Arrange for final deletion of the main interp
-	 */
-	/* ARGH Munchhausen effect  */
-	Tcl_CreateExitHandler(FreeMainInterp, (ClientData)interp);
-    }
 
     /*
-     * Invoke the script specified on the command line, if any. Must fetch it
-     * again, as the appInitProc might have reset it.
+     * If a script file was specified then just source that file
+     * and quit.
      */
 
-    path = Tcl_GetStartupScript(&encodingName);
-    if (path != NULL) {
-	Tcl_ResetResult(interp);
-	code = Tcl_FSEvalFileEx(interp, path, encodingName);
+    if (TclGetStartupScriptPath() != NULL) {
+	code = Tcl_FSEvalFile(interp, TclGetStartupScriptPath());
 	if (code != TCL_OK) {
-	    chan = Tcl_GetStdChannel(TCL_STDERR);
-	    if (chan) {
-		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);
-
-		if (valuePtr) {
-		    Tcl_WriteObj(chan, valuePtr);
-		}
-		Tcl_WriteChars(chan, "\n", 1);
-		Tcl_DecrRefCount(options);
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	    if (errChannel) {
+
+		/*
+		 * The following statement guarantees that the errorInfo
+		 * variable is set properly.
+		 */
+
+		Tcl_AddErrorInfo(interp, "");
+		Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
+			NULL, TCL_GLOBAL_ONLY));
+		Tcl_WriteChars(errChannel, "\n", 1);
 	    }
 	    exitCode = 1;
 	}
@@ -431,336 +311,272 @@ Tcl_MainEx(
     }
 
     /*
-     * 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.
      */
 
-    Tcl_IncrRefCount(is.commandPtr);
+    commandPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(commandPtr);
 
     /*
      * Get a new value for tty if anyone writes to ::tcl_interactive
      */
-
-    Tcl_LinkVar(interp, "tcl_interactive", (char *) &is.tty, TCL_LINK_BOOLEAN);
-    is.input = Tcl_GetStdChannel(TCL_STDIN);
-    while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
-	mainLoopProc = TclGetMainLoop();
+    Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
+    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+    while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
 	if (mainLoopProc == NULL) {
-	    int length;
-	    if (is.tty) {
-		Prompt(interp, &is);
+	    if (tty) {
+		Prompt(interp, &prompt);
 		if (Tcl_InterpDeleted(interp)) {
 		    break;
 		}
-		if (Tcl_LimitExceeded(interp)) {
-		    break;
-		}
-		is.input = Tcl_GetStdChannel(TCL_STDIN);
-		if (is.input == NULL) {
-		    break;
+		inChannel = Tcl_GetStdChannel(TCL_STDIN);
+		if (inChannel == (Tcl_Channel) NULL) {
+	            break;
 		}
 	    }
-	    if (Tcl_IsShared(is.commandPtr)) {
-		Tcl_DecrRefCount(is.commandPtr);
-		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
-		Tcl_IncrRefCount(is.commandPtr);
+	    if (Tcl_IsShared(commandPtr)) {
+		Tcl_DecrRefCount(commandPtr);
+		commandPtr = Tcl_DuplicateObj(commandPtr);
+		Tcl_IncrRefCount(commandPtr);
 	    }
-	    length = Tcl_GetsObj(is.input, is.commandPtr);
+            length = Tcl_GetsObj(inChannel, commandPtr);
 	    if (length < 0) {
-		if (Tcl_InputBlocked(is.input)) {
+		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. Have
-	     * to add it back before testing completeness, because it can make
-	     * a difference. [Bug 1775878]
-	     */
+            /*
+             * Add the newline removed by Tcl_GetsObj back to the string.
+             */
 
-	    if (Tcl_IsShared(is.commandPtr)) {
-		Tcl_DecrRefCount(is.commandPtr);
-		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
-		Tcl_IncrRefCount(is.commandPtr);
+	    if (Tcl_IsShared(commandPtr)) {
+		Tcl_DecrRefCount(commandPtr);
+		commandPtr = Tcl_DuplicateObj(commandPtr);
+		Tcl_IncrRefCount(commandPtr);
 	    }
-	    Tcl_AppendToObj(is.commandPtr, "\n", 1);
-	    if (!TclObjCommandComplete(is.commandPtr)) {
-		is.prompt = PROMPT_CONTINUE;
+	    Tcl_AppendToObj(commandPtr, "\n", 1);
+	    if (!TclObjCommandComplete(commandPtr)) {
+		prompt = PROMPT_CONTINUE;
 		continue;
 	    }
 
-	    is.prompt = PROMPT_START;
-
-	    /*
-	     * The final newline is syntactically redundant, and causes some
-	     * error messages troubles deeper in, so lop it back off.
-	     */
-
-	    Tcl_GetStringFromObj(is.commandPtr, &length);
-	    Tcl_SetObjLength(is.commandPtr, --length);
-	    code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL);
-	    is.input = Tcl_GetStdChannel(TCL_STDIN);
-	    Tcl_DecrRefCount(is.commandPtr);
-	    is.commandPtr = Tcl_NewObj();
-	    Tcl_IncrRefCount(is.commandPtr);
+	    prompt = PROMPT_START;
+	    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
+	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	    Tcl_DecrRefCount(commandPtr);
+	    commandPtr = Tcl_NewObj();
+	    Tcl_IncrRefCount(commandPtr);
 	    if (code != TCL_OK) {
-		chan = Tcl_GetStdChannel(TCL_STDERR);
-		if (chan) {
-		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
-		    Tcl_WriteChars(chan, "\n", 1);
+		if (errChannel) {
+		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+		    Tcl_WriteChars(errChannel, "\n", 1);
 		}
-	    } else if (is.tty) {
+	    } else if (tty) {
 		resultPtr = Tcl_GetObjResult(interp);
 		Tcl_IncrRefCount(resultPtr);
 		Tcl_GetStringFromObj(resultPtr, &length);
-		chan = Tcl_GetStdChannel(TCL_STDOUT);
-		if ((length > 0) && chan) {
-		    Tcl_WriteObj(chan, resultPtr);
-		    Tcl_WriteChars(chan, "\n", 1);
+		if ((length > 0) && outChannel) {
+		    Tcl_WriteObj(outChannel, resultPtr);
+		    Tcl_WriteChars(outChannel, "\n", 1);
 		}
 		Tcl_DecrRefCount(resultPtr);
 	    }
 	} 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.
 	     */
 
-	    if (is.input) {
-		if (is.tty) {
-		    Prompt(interp, &is);
-		}
-
-		Tcl_CreateChannelHandler(is.input, TCL_READABLE, StdinProc, &is);
+	    InteractiveState *isPtr = NULL;
+
+	    if (inChannel) {
+	        if (tty) {
+		    Prompt(interp, &prompt);
+	        }
+		isPtr = (InteractiveState *) 
+			ckalloc((int) sizeof(InteractiveState));
+		isPtr->input = inChannel;
+		isPtr->tty = tty;
+		isPtr->commandPtr = commandPtr;
+		isPtr->prompt = prompt;
+		isPtr->interp = interp;
+
+		Tcl_UnlinkVar(interp, "tcl_interactive");
+		Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
+			TCL_LINK_BOOLEAN);
+
+		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
+			(ClientData) isPtr);
 	    }
 
-	    mainLoopProc();
-	    Tcl_SetMainLoop(NULL);
-
-	    if (is.input) {
-		Tcl_DeleteChannelHandler(is.input, StdinProc, &is);
+	    (*mainLoopProc)();
+	    mainLoopProc = NULL;
+
+	    if (inChannel) {
+		tty = isPtr->tty;
+		Tcl_UnlinkVar(interp, "tcl_interactive");
+		Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
+			TCL_LINK_BOOLEAN);
+		prompt = isPtr->prompt;
+		commandPtr = isPtr->commandPtr;
+		if (isPtr->input != (Tcl_Channel) NULL) {
+		    Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
+			    (ClientData) isPtr);
+		}
+		ckfree((char *)isPtr);
 	    }
-	    is.input = Tcl_GetStdChannel(TCL_STDIN);
+	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
+	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
 	}
 #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) {
-	    Tcl_SetMainLoop(NULL);
+	    mainLoopProc = NULL;
 	    Tcl_DeleteInterp(interp);
 	}
 #endif
     }
 
-  done:
-    mainLoopProc = TclGetMainLoop();
-    if ((exitCode == 0) && (mainLoopProc != NULL)
-	    && !Tcl_LimitExceeded(interp)) {
+    done:
+    if ((exitCode == 0) && (mainLoopProc != NULL)) {
+
 	/*
-	 * 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();
-	Tcl_SetMainLoop(NULL);
+	(*mainLoopProc)();
+	mainLoopProc = NULL;
     }
-    if (is.commandPtr != NULL) {
-	Tcl_DecrRefCount(is.commandPtr);
+    if (commandPtr != NULL) {
+	Tcl_DecrRefCount(commandPtr);
     }
 
     /*
-     * 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.
+     * 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.
      */
 
     if (!Tcl_InterpDeleted(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.
-	 */
-    Tcl_Exit(exitCode);
-}
+	char buffer[TCL_INTEGER_SPACE + 5];
+        sprintf(buffer, "exit %d", exitCode);
+        Tcl_Eval(interp, buffer);
 
-#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE)
-#undef Tcl_Main
-extern DLLEXPORT void
-Tcl_Main(
-    int argc,			/* Number of arguments. */
-    char **argv,		/* Array of argument strings. */
-    Tcl_AppInitProc *appInitProc)
-				/* Application-specific initialization
-				 * function to call after most initialization
-				 * but before starting to execute commands. */
-{
-    Tcl_FindExecutable(argv[0]);
-    Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
-}
-#endif
-
-#ifndef TCL_ASCII_MAIN
+        /*
+         * 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.
+         */
 
-/*
- *---------------------------------------------------------------
- *
- * Tcl_SetMainLoop --
- *
- *	Sets an alternative main loop function.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	This function will be called before Tcl exits, allowing for the
- *	creation of an event loop.
- *
- *---------------------------------------------------------------
- */
+        if (!Tcl_InterpDeleted(interp)) {
+            Tcl_DeleteInterp(interp);
+        }
+    }
+    TclSetStartupScriptPath(NULL);
 
-void
-Tcl_SetMainLoop(
-    Tcl_MainLoopProc *proc)
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    /*
+     * If we get here, the master interp has been deleted.  Allow
+     * its destruction with the last matching Tcl_Release.
+     */
 
-    tsdPtr->mainLoopProc = proc;
+    Tcl_Release((ClientData) interp);
+    Tcl_Exit(exitCode);
 }
 
 /*
  *---------------------------------------------------------------
  *
- * TclGetMainLoop --
+ * Tcl_SetMainLoop --
  *
- *	Returns the current alternative main loop function.
+ *	Sets an alternative main loop procedure.
  *
  * Results:
- *	Returns the previously defined main loop function, or NULL to indicate
- *	that no such function has been installed and standard tclsh behaviour
- *	(i.e., exit once the script is evaluated if not interactive) is
- *	requested..
+ *	Returns the previously defined main loop procedure.
  *
  * Side effects:
- *	None (other than possible creation of this file's TSD block).
+ *	This procedure will be called before Tcl exits, allowing for
+ *	the creation of an event loop.
  *
  *---------------------------------------------------------------
  */
 
-Tcl_MainLoopProc *
-TclGetMainLoop(void)
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    return tsdPtr->mainLoopProc;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFullFinalizationRequested --
- *
- *	This function returns true when either -DPURIFY is specified, or the
- *	environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This
- *	predicate is called at places affecting the exit sequence, so that the
- *	default behavior is a fast and deadlock-free exit, and the modified
- *	behavior is a more thorough finalization for debugging purposes (leak
- *	hunting etc).
- *
- * Results:
- *	A boolean.
- *
- *----------------------------------------------------------------------
- */
-MODULE_SCOPE int
-TclFullFinalizationRequested(void)
+void
+Tcl_SetMainLoop(proc)
+    Tcl_MainLoopProc *proc;
 {
-#ifdef PURIFY
-    return 1;
-#else
-    const char *fin;
-    Tcl_DString ds;
-    int finalize = 0;
-    
-    fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds);
-    finalize = ((fin != NULL) && strcmp(fin, "0"));
-    if (fin != NULL) {
-	Tcl_DStringFree(&ds);
-    }
-    return finalize;
-#endif
+    mainLoopProc = proc;
 }
-#endif /* !TCL_ASCII_MAIN */
 
 /*
  *----------------------------------------------------------------------
  *
  * StdinProc --
  *
- *	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.
+ *	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.
  *
  * 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 clientData,	/* The state of interactive cmd line */
-    int mask)			/* Not used. */
+StdinProc(clientData, mask)
+    ClientData clientData;		/* The state of interactive cmd line */
+    int mask;				/* Not used. */
 {
-    int code, length;
-    InteractiveState *isPtr = clientData;
+    InteractiveState *isPtr = (InteractiveState *) clientData;
     Tcl_Channel chan = isPtr->input;
     Tcl_Obj *commandPtr = isPtr->commandPtr;
     Tcl_Interp *interp = isPtr->interp;
+    int code, length;
 
     if (Tcl_IsShared(commandPtr)) {
 	Tcl_DecrRefCount(commandPtr);
@@ -774,14 +590,13 @@ StdinProc(
 	}
 	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, isPtr);
+	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
 	return;
     }
 
@@ -792,45 +607,43 @@ StdinProc(
     }
     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, isPtr);
+    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
     code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
     isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
     Tcl_DecrRefCount(commandPtr);
     isPtr->commandPtr = commandPtr = Tcl_NewObj();
     Tcl_IncrRefCount(commandPtr);
-    if (chan != NULL) {
-	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
+    if (chan != (Tcl_Channel) NULL) {
+	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
+		(ClientData) isPtr);
     }
     if (code != TCL_OK) {
-	chan = Tcl_GetStdChannel(TCL_STDERR);
-
-	if (chan != NULL) {
-	    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
-	    Tcl_WriteChars(chan, "\n", 1);
+	Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
+	if (errChannel != (Tcl_Channel) NULL) {
+	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+	    Tcl_WriteChars(errChannel, "\n", 1);
 	}
     } else if (isPtr->tty) {
 	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-	chan = Tcl_GetStdChannel(TCL_STDOUT);
-
+	Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
 	Tcl_IncrRefCount(resultPtr);
 	Tcl_GetStringFromObj(resultPtr, &length);
-	if ((length > 0) && (chan != NULL)) {
-	    Tcl_WriteObj(chan, resultPtr);
-	    Tcl_WriteChars(chan, "\n", 1);
+	if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
+	    Tcl_WriteObj(outChannel, resultPtr);
+	    Tcl_WriteChars(outChannel, "\n", 1);
 	}
 	Tcl_DecrRefCount(resultPtr);
     }
@@ -839,9 +652,9 @@ StdinProc(
      * If a tty stdin is still around, output a prompt.
      */
 
-  prompt:
-    if (isPtr->tty && (isPtr->input != NULL)) {
-	Prompt(interp, isPtr);
+    prompt:
+    if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
+	Prompt(interp, &(isPtr->prompt));
 	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
     }
 }
@@ -851,100 +664,63 @@ StdinProc(
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter to use for prompting. */
-    InteractiveState *isPtr) /* InteractiveState. Filled
-				 * with PROMPT_NONE after a prompt is
-				 * printed. */
+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. */
 {
     Tcl_Obj *promptCmdPtr;
     int code;
-    Tcl_Channel chan;
+    Tcl_Channel outChannel, errChannel;
 
-    if (isPtr->prompt == PROMPT_NONE) {
+    if (*promptPtr == PROMPT_NONE) {
 	return;
     }
 
     promptCmdPtr = Tcl_GetVar2Ex(interp,
-	    ((isPtr->prompt == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
+	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
 	    NULL, TCL_GLOBAL_ONLY);
-
     if (Tcl_InterpDeleted(interp)) {
 	return;
     }
     if (promptCmdPtr == NULL) {
-    defaultPrompt:
-	if (isPtr->prompt == PROMPT_START) {
-	    chan = Tcl_GetStdChannel(TCL_STDOUT);
-	    if (chan != NULL) {
-		Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
-			strlen(DEFAULT_PRIMARY_PROMPT));
-	    }
+	defaultPrompt:
+	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+	if ((*promptPtr == PROMPT_START)
+		&& (outChannel != (Tcl_Channel) NULL)) {
+	    Tcl_WriteChars(outChannel, "% ", 2);
 	}
     } else {
 	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
 	if (code != TCL_OK) {
 	    Tcl_AddErrorInfo(interp,
 		    "\n    (script that generates prompt)");
-	    chan = Tcl_GetStdChannel(TCL_STDERR);
-	    if (chan != NULL) {
-		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
-		Tcl_WriteChars(chan, "\n", 1);
-	    }
+	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
+            if (errChannel != (Tcl_Channel) NULL) {
+                Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+                Tcl_WriteChars(errChannel, "\n", 1);
+            }
 	    goto defaultPrompt;
 	}
     }
-
-    chan = Tcl_GetStdChannel(TCL_STDOUT);
-    if (chan != NULL) {
-	Tcl_Flush(chan);
+    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
+    if (outChannel != (Tcl_Channel) NULL) {
+	Tcl_Flush(outChannel);
     }
-    isPtr->prompt = PROMPT_NONE;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeMainInterp --
- *
- *	Exit handler used to cleanup the main interpreter and ancillary startup
- *	script storage at exit.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeMainInterp(
-    ClientData clientData)
-{
-	Tcl_Interp *interp = (Tcl_Interp *) clientData;
-
-	/*if (TclInExit()) return;*/
-
-	if (!Tcl_InterpDeleted(interp)) {
-	    Tcl_DeleteInterp(interp);
-	}
-    Tcl_SetStartupScript(NULL, NULL);
-    Tcl_Release(interp);
+    *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
new file mode 100644
index 0000000..7492af0
--- /dev/null
+++ b/generic/tclMath.h
@@ -0,0 +1,25 @@
+/*
+ * 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
+
+#if defined(MAC_TCL)
+#   include "tclMacMath.h"
+#else
+#   include <math.h>
+#endif
+
+#endif /* _TCLMATH */
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 73bc644..77352a1 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -1,194 +1,164 @@
 /*
  * 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.
  *
  * 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"
-#include "tclCompile.h" /* for NRCommand; and TclLogCommandInfo visibility */
 
 /*
- * Thread-local storage used to avoid having a global lock on data that is not
- * limited to a single interpreter.
+ * 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.
  */
 
-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;
+#define FIND_ONLY_NS	0x1000
 
 /*
- * 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.
+ * Initial size of stack allocated space for tail list - used when resetting
+ * shadowed command references in the functin: TclResetShadowedCmdRefs.
  */
 
-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;
+#define NUM_TRAIL_ELEMS 5
 
 /*
- * Declarations for functions local to this file:
+ * Count of the number of namespaces created. This value is used as a
+ * unique id for each namespace.
  */
 
-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		InvokeImportedNRCmd(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		NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		NRNamespaceEvalCmd(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		NRNamespaceInscopeCmd(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 void		UnlinkNsPath(Namespace *nsPtr);
-
-static Tcl_NRPostProc NsEval_Callback;
+static long numNsCreated = 0; 
+TCL_DECLARE_MUTEX(nsMutex)
 
 /*
- * 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.
+ * 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.
  */
 
-static const Tcl_ObjType nsNameType = {
+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;
+
+/*
+ * 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 = {
     "nsName",			/* the type's name */
     FreeNsNameInternalRep,	/* freeIntRepProc */
     DupNsNameInternalRep,	/* dupIntRepProc */
-    NULL,			/* updateStringProc */
+    UpdateStringOfNsName,	/* updateStringProc */
     SetNsNameFromAny		/* setFromAnyProc */
 };
-
-/*
- * Array of values describing how to implement each standard subcommand of the
- * "namespace" command.
- */
-
-static const EnsembleImplMap defaultNamespaceMap[] = {
-    {"children",        NamespaceChildrenCmd, NULL, NULL, NULL, 0},
-    {"code",            NamespaceCodeCmd, NULL, NULL, NULL, 0},
-    {"current",         NamespaceCurrentCmd, NULL, NULL, NULL, 0},
-    {"delete",          NamespaceDeleteCmd, NULL, NULL, NULL, 0},
-    {"ensemble",        TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
-    {"eval",            NamespaceEvalCmd,       NULL, NRNamespaceEvalCmd, NULL, 0},
-    {"exists",          NamespaceExistsCmd, NULL, NULL, NULL, 0},
-    {"export",          NamespaceExportCmd, NULL, NULL, NULL, 0},
-    {"forget",          NamespaceForgetCmd, NULL, NULL, NULL, 0},
-    {"import",          NamespaceImportCmd, NULL, NULL, NULL, 0},
-    {"inscope",         NamespaceInscopeCmd,    NULL, NRNamespaceInscopeCmd, NULL, 0},
-    {"origin",          NamespaceOriginCmd, NULL, NULL, NULL, 0},
-    {"parent",          NamespaceParentCmd, NULL, NULL, NULL, 0},
-    {"path",            NamespacePathCmd, NULL, NULL, NULL, 0},
-    {"qualifiers",      NamespaceQualifiersCmd, NULL, NULL, NULL, 0},
-    {"tail",            NamespaceTailCmd, NULL, NULL, NULL, 0},
-    {"unknown",         NamespaceUnknownCmd, NULL, NULL, NULL, 0},
-    {"upvar",           NamespaceUpvarCmd,      TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
-    {"which",           NamespaceWhichCmd, NULL, NULL, NULL, 0},
-    {NULL, NULL, NULL, NULL, NULL, 0}
-};
 
 /*
  *----------------------------------------------------------------------
  *
  * TclInitNamespaceSubsystem --
  *
- *	This function is called to initialize all the structures that are used
- *	by namespaces on a per-process basis.
+ *	This procedure is called to initialize all the structures that 
+ *	are used by namespaces on a per-process basis.
  *
  * Results:
  *	None.
@@ -200,7 +170,7 @@ static const EnsembleImplMap defaultNamespaceMap[] = {
  */
 
 void
-TclInitNamespaceSubsystem(void)
+TclInitNamespaceSubsystem()
 {
     /*
      * Does nothing for now.
@@ -224,11 +194,19 @@ TclInitNamespaceSubsystem(void)
  */
 
 Tcl_Namespace *
-Tcl_GetCurrentNamespace(
-    register Tcl_Interp *interp)/* Interpreter whose current namespace is
-				 * being queried. */
+Tcl_GetCurrentNamespace(interp)
+    register Tcl_Interp *interp; /* Interpreter whose current namespace is
+				  * being queried. */
 {
-    return TclGetCurrentNamespace(interp);
+    register Interp *iPtr = (Interp *) interp;
+    register Namespace *nsPtr;
+
+    if (iPtr->varFramePtr != NULL) {
+        nsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+        nsPtr = iPtr->globalNsPtr;
+    }
+    return (Tcl_Namespace *) nsPtr;
 }
 
 /*
@@ -248,11 +226,13 @@ Tcl_GetCurrentNamespace(
  */
 
 Tcl_Namespace *
-Tcl_GetGlobalNamespace(
-    register Tcl_Interp *interp)/* Interpreter whose global namespace should
-				 * be returned. */
+Tcl_GetGlobalNamespace(interp)
+    register Tcl_Interp *interp; /* Interpreter whose global namespace 
+				  * should be returned. */
 {
-    return TclGetGlobalNamespace(interp);
+    register Interp *iPtr = (Interp *) interp;
+    
+    return (Tcl_Namespace *) iPtr->globalNsPtr;
 }
 
 /*
@@ -260,9 +240,9 @@ Tcl_GetGlobalNamespace(
  *
  * 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
@@ -275,53 +255,45 @@ Tcl_GetGlobalNamespace(
  */
 
 int
-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. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
     register CallFrame *framePtr = (CallFrame *) callFramePtr;
     register Namespace *nsPtr;
 
     if (namespacePtr == NULL) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
     } else {
-	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");
+        nsPtr = (Namespace *) namespacePtr;
+        if (nsPtr->flags & NS_DEAD) {
+	    panic("Trying to push call frame for dead namespace");
 	    /*NOTREACHED*/
-	}
+        }
     }
 
     nsPtr->activationCount++;
@@ -332,26 +304,22 @@ Tcl_PushCallFrame(
     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 = 0;
+        framePtr->level = 1;
     }
-    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;
-    framePtr->tailcallPtr = 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;
     iPtr->varFramePtr = framePtr;
-
     return TCL_OK;
 }
 
@@ -368,264 +336,53 @@ Tcl_PushCallFrame(
  *
  * 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(
-    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
+Tcl_PopCallFrame(interp)
+    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.
      */
 
-    if (framePtr->callerPtr) {
-	iPtr->framePtr = framePtr->callerPtr;
-	iPtr->varFramePtr = framePtr->callerVarPtr;
-    } else {
-	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
-    }
+    iPtr->framePtr = framePtr->callerPtr;
+    iPtr->varFramePtr = framePtr->callerVarPtr;
 
     if (framePtr->varTablePtr != NULL) {
-	TclDeleteVars(iPtr, framePtr->varTablePtr);
-	ckfree(framePtr->varTablePtr);
-	framePtr->varTablePtr = NULL;
+        TclDeleteVars(iPtr, framePtr->varTablePtr);
+        ckfree((char *) framePtr->varTablePtr);
+        framePtr->varTablePtr = NULL;
     }
     if (framePtr->numCompiledLocals > 0) {
-	TclDeleteCompiledLocalVars(iPtr, framePtr);
-	if (--framePtr->localCachePtr->refCount == 0) {
-	    TclFreeLocalCache(interp, framePtr->localCachePtr);
-	}
-	framePtr->localCachePtr = NULL;
+        TclDeleteCompiledLocalVars(iPtr, framePtr);
     }
 
     /*
-     * 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 - (nsPtr == iPtr->globalNsPtr) == 0)) {
-	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
+	    && (nsPtr->activationCount == 0)) {
+        Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
     }
     framePtr->nsPtr = NULL;
-
-    if (framePtr->tailcallPtr) {
-        TclSpliceTailcall(interp, framePtr->tailcallPtr);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 = 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;
 }
 
 /*
@@ -633,161 +390,135 @@ ErrorInfoRead(
  *
  * 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(
-    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. */
+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. */
 {
     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;
-    Tcl_DString *namePtr, *buffPtr;
-    int newEntry, nameLen;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    int newEntry;
 
     /*
-     * 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_ResetResult(interp);
-	Tcl_AppendResult(interp, "can't create namespace \"\": "
-		"only global namespace can have empty name", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
-                "CREATEGLOBAL", NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create namespace \"\": only global namespace can have empty name", (char *) NULL);
 	return NULL;
     } else {
 	/*
 	 * Find the parent for the new namespace.
 	 */
 
-	TclGetNamespaceForQualName(interp, name, NULL,
-		/*flags*/ (TCL_CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+	TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
+		/*flags*/ (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 (
-#ifndef BREAK_NAMESPACE_COMPAT
-	    Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
-#else
-	    parentPtr->childTablePtr != NULL &&
-	    Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
-#endif
-	) {
-	    Tcl_AppendResult(interp, "can't create namespace \"", name,
-		    "\": already exists", NULL);
-            Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
-                    "CREATEEXISTING", NULL);
-	    return NULL;
-	}
+        if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "can't create namespace \"", name,
+    	    	    "\": already exists", (char *) 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 = ckalloc(sizeof(Namespace));
-    nameLen = strlen(simpleName) + 1;
-    nsPtr->name = ckalloc(nameLen);
-    memcpy(nsPtr->name, simpleName, nameLen);
-    nsPtr->fullName = NULL;		/* Set below. */
-    nsPtr->clientData = clientData;
-    nsPtr->deleteProc = deleteProc;
-    nsPtr->parentPtr = parentPtr;
-#ifndef BREAK_NAMESPACE_COMPAT
+
+    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
+    nsPtr->name            = (char *) ckalloc((unsigned) (strlen(simpleName)+1));
+    strcpy(nsPtr->name, simpleName);
+    nsPtr->fullName        = NULL;   /* set below */
+    nsPtr->clientData      = clientData;
+    nsPtr->deleteProc      = deleteProc;
+    nsPtr->parentPtr       = parentPtr;
     Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
-#else
-    nsPtr->childTablePtr = NULL;
-#endif
-    nsPtr->nsId = ++(tsdPtr->numNsCreated);
-    nsPtr->interp = interp;
-    nsPtr->flags = 0;
+    Tcl_MutexLock(&nsMutex);
+    numNsCreated++;
+    nsPtr->nsId            = numNsCreated;
+    Tcl_MutexUnlock(&nsMutex);
+    nsPtr->interp          = interp;
+    nsPtr->flags           = 0;
     nsPtr->activationCount = 0;
-    nsPtr->refCount = 0;
+    nsPtr->refCount        = 0;
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
-    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
-    nsPtr->exportArrayPtr = NULL;
+    Tcl_InitHashTable(&nsPtr->varTable, TCL_STRING_KEYS);
+    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;
-    nsPtr->earlyDeleteProc = NULL;
 
     if (parentPtr != NULL) {
-	entryPtr = Tcl_CreateHashEntry(
-		TclGetNamespaceChildTable((Tcl_Namespace *) parentPtr),
-		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);
+        entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
+	        &newEntry);
+        Tcl_SetHashValue(entryPtr, (ClientData) nsPtr);
     }
 
     /*
@@ -796,56 +527,27 @@ Tcl_CreateNamespace(
 
     Tcl_DStringInit(&buffer1);
     Tcl_DStringInit(&buffer2);
-    namePtr = &buffer1;
-    buffPtr = &buffer2;
-    for (ancestorPtr = nsPtr; ancestorPtr != NULL;
+    for (ancestorPtr = nsPtr;  ancestorPtr != NULL;
 	    ancestorPtr = ancestorPtr->parentPtr) {
-	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(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.
-	     */
+        if (ancestorPtr != globalNsPtr) {
+            Tcl_DStringAppend(&buffer1, "::", 2);
+            Tcl_DStringAppend(&buffer1, ancestorPtr->name, -1);
+        }
+        Tcl_DStringAppend(&buffer1, Tcl_DStringValue(&buffer2), -1);
 
-	    namePtr = buffPtr;
-	    buffPtr = tempPtr;
-	}
+        Tcl_DStringSetLength(&buffer2, 0);
+        Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer1), -1);
+        Tcl_DStringSetLength(&buffer1, 0);
     }
-
-    name = Tcl_DStringValue(namePtr);
-    nameLen = Tcl_DStringLength(namePtr);
-    nsPtr->fullName = ckalloc(nameLen + 1);
-    memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);
+    
+    name = Tcl_DStringValue(&buffer2);
+    nsPtr->fullName = (char *) ckalloc((unsigned) (strlen(name)+1));
+    strcpy(nsPtr->fullName, name);
 
     Tcl_DStringFree(&buffer1);
     Tcl_DStringFree(&buffer2);
 
     /*
-     * If compilation of commands originating from the parent NS is
-     * suppressed, suppress it for commands originating in this one too.
-     */
-
-    if (nsPtr->parentPtr != NULL &&
-	    nsPtr->parentPtr->flags & NS_SUPPRESS_COMPILATION) {
-	nsPtr->flags |= NS_SUPPRESS_COMPILATION;
-    }
-
-    /*
      * Return a pointer to the new namespace.
      */
 
@@ -864,124 +566,50 @@ Tcl_CreateNamespace(
  *	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(
-    Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
+Tcl_DeleteNamespace(namespacePtr)
+    Tcl_Namespace *namespacePtr;   /* Points to the namespace to delete. */
 {
     register Namespace *nsPtr = (Namespace *) namespacePtr;
     Interp *iPtr = (Interp *) nsPtr->interp;
-    Namespace *globalNsPtr = (Namespace *)
-	    TclGetGlobalNamespace((Tcl_Interp *) iPtr);
+    Namespace *globalNsPtr =
+	    (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr);
     Tcl_HashEntry *entryPtr;
-    Tcl_HashSearch search;
-    Command *cmdPtr;
-
-    /*
-     * Give anyone interested - notably TclOO - a chance to use this namespace
-     * normally despite the fact that the namespace is going to go. Allows the
-     * calling of destructors. Will only be called once (unless re-established
-     * by the called function). [Bug 2950259]
-     *
-     * Note that setting this field requires access to the internal definition
-     * of namespaces, so it should only be accessed by code that knows about
-     * being careful with reentrancy.
-     */
-
-    if (nsPtr->earlyDeleteProc != NULL) {
-	Tcl_NamespaceDeleteProc *earlyDeleteProc = nsPtr->earlyDeleteProc;
-
-	nsPtr->earlyDeleteProc = NULL;
-	nsPtr->activationCount++;
-	earlyDeleteProc(nsPtr->clientData);
-	nsPtr->activationCount--;
-    }
-
-    /*
-     * Delete all coroutine commands now: break the circular ref cycle between
-     * the namespace and the coroutine command [Bug 2724403]. This code is
-     * essentially duplicated in TclTeardownNamespace() for all other
-     * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
-     *
-     * NOTE: we could avoid traversing the ns's command list by keeping a
-     * separate list of coros.
-     */
-
-    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	    entryPtr != NULL;) {
-	cmdPtr = Tcl_GetHashValue(entryPtr);
-	if (cmdPtr->nreProc == NRInterpCoroutine) {
-	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
-		    (Tcl_Command) cmdPtr);
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-	} else {
-	    entryPtr = Tcl_NextHashEntry(&search);
-	}
-    }
-
-    /*
-     * 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
-     * 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(
-		    TclGetNamespaceChildTable((Tcl_Namespace *)
-			    nsPtr->parentPtr), nsPtr->name);
-	    if (entryPtr != NULL) {
-		Tcl_DeleteHashEntry(entryPtr);
-	    }
-	}
-	nsPtr->parentPtr = NULL;
+     * (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,
+		    nsPtr->name);
+            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
@@ -992,53 +620,38 @@ Tcl_DeleteNamespace(
 	 */
 
 	nsPtr->flags |= (NS_DYING|NS_KILLED);
+	
+        TclTeardownNamespace(nsPtr);
 
-	TclTeardownNamespace(nsPtr);
-
-	if ((nsPtr != globalNsPtr) || (iPtr->flags & DELETED)) {
-	    /*
+        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);
-
-#ifndef BREAK_NAMESPACE_COMPAT
-	    Tcl_DeleteHashTable(&nsPtr->childTable);
-#else
-	    if (nsPtr->childTablePtr != NULL) {
-		Tcl_DeleteHashTable(nsPtr->childTablePtr);
-		ckfree(nsPtr->childTablePtr);
-	    }
-#endif
-	    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.
-	     */
+            TclDeleteNamespaceVars(nsPtr);
+	    
+            Tcl_DeleteHashTable(&nsPtr->childTable);
+            Tcl_DeleteHashTable(&nsPtr->cmdTable);
 
-	    if (nsPtr->refCount == 0) {
-		NamespaceFree(nsPtr);
-	    } else {
-		nsPtr->flags |= NS_DEAD;
-	    }
-	} else {
-	    /*
-	     * Restore the ::errorInfo and ::errorCode traces.
-	     */
-
-	    EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
-	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);
+            /*
+             * 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 {
 	    /*
-	     * 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);
 	}
     }
 }
@@ -1053,7 +666,9 @@ Tcl_DeleteNamespace(
  *	commands, variables, and child namespaces.
  *
  *	This is kept separate from Tcl_DeleteNamespace so that the global
- *	namespace can be handled specially.
+ *	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.
  *
  * Results:
  *	None.
@@ -1061,13 +676,15 @@ Tcl_DeleteNamespace(
  * 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(
-    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
+TclTeardownNamespace(nsPtr)
+    register Namespace *nsPtr;	/* Points to the namespace to be dismantled
 				 * and unlinked from its parent. */
 {
     Interp *iPtr = (Interp *) nsPtr->interp;
@@ -1075,30 +692,69 @@ TclTeardownNamespace(
     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. Variable table should be cleared but not freed!
-     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
+     * Start by destroying the namespace's variable table,
+     * since variables might trigger traces.
      */
 
-    TclDeleteNamespaceVars(nsPtr);
-    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
+    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);
+    }
 
     /*
      * 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_GetHashValue(entryPtr);
-	Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
+            entryPtr != NULL;
+            entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
+        cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
+        Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
     }
     Tcl_DeleteHashTable(&nsPtr->cmdTable);
     Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
@@ -1108,63 +764,29 @@ TclTeardownNamespace(
      */
 
     if (nsPtr->parentPtr != NULL) {
-	entryPtr = Tcl_FindHashEntry(
-		TclGetNamespaceChildTable((Tcl_Namespace *)
-			nsPtr->parentPtr), 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.
-     *
-     * Don't optimize to Tcl_NextHashEntry() because of traces.
+     * 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.
      */
 
-#ifndef BREAK_NAMESPACE_COMPAT
     for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-	    entryPtr != NULL;
-	    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
-	childNsPtr = Tcl_GetHashValue(entryPtr);
-	Tcl_DeleteNamespace(childNsPtr);
+            entryPtr != NULL;
+            entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
+        childNsPtr = (Tcl_Namespace *) Tcl_GetHashValue(entryPtr);
+        Tcl_DeleteNamespace(childNsPtr);
     }
-#else
-    if (nsPtr->childTablePtr != NULL) {
-	for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr,&search)) {
-	    childNsPtr = Tcl_GetHashValue(entryPtr);
-	    Tcl_DeleteNamespace(childNsPtr);
-	}
-    }
-#endif
 
     /*
      * Free the namespace's export pattern array.
@@ -1174,7 +796,7 @@ TclTeardownNamespace(
 	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
 	    ckfree(nsPtr->exportArrayPtr[i]);
 	}
-	ckfree(nsPtr->exportArrayPtr);
+        ckfree((char *) nsPtr->exportArrayPtr);
 	nsPtr->exportArrayPtr = NULL;
 	nsPtr->numExportPatterns = 0;
 	nsPtr->maxExportPatterns = 0;
@@ -1185,15 +807,15 @@ TclTeardownNamespace(
      */
 
     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;
@@ -1204,8 +826,9 @@ TclTeardownNamespace(
  *
  * 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.
@@ -1217,8 +840,8 @@ TclTeardownNamespace(
  */
 
 static void
-NamespaceFree(
-    register Namespace *nsPtr)	/* Points to the namespace to free. */
+NamespaceFree(nsPtr)
+    register Namespace *nsPtr;	/* Points to the namespace to free. */
 {
     /*
      * Most of the namespace's contents are freed when the namespace is
@@ -1228,35 +851,10 @@ NamespaceFree(
 
     ckfree(nsPtr->name);
     ckfree(nsPtr->fullName);
-    ckfree(nsPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclNsDecrRefCount --
- *
- *	Drops a reference to a namespace and frees it if the namespace has
- *	been deleted and the last reference has just been dropped.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
 
-void
-TclNsDecrRefCount(
-    Namespace *nsPtr)
-{
-    nsPtr->refCount--;
-    if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
-	NamespaceFree(nsPtr);
-    }
+    ckfree((char *) nsPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -1264,10 +862,10 @@ TclNsDecrRefCount(
  * 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
@@ -1281,22 +879,23 @@ TclNsDecrRefCount(
  */
 
 int
-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
+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    
     Namespace *nsPtr, *exportNsPtr, *dummyPtr;
-    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    const char *simplePattern;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    CONST char *simplePattern;
     char *patternCpy;
     int neededElems, len, i;
 
@@ -1305,9 +904,9 @@ Tcl_Export(
      */
 
     if (namespacePtr == NULL) {
-	nsPtr = (Namespace *) currNsPtr;
+        nsPtr = (Namespace *) currNsPtr;
     } else {
-	nsPtr = (Namespace *) namespacePtr;
+        nsPtr = (Namespace *) namespacePtr;
     }
 
     /*
@@ -1320,9 +919,8 @@ Tcl_Export(
 	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
 		ckfree(nsPtr->exportArrayPtr[i]);
 	    }
-	    ckfree(nsPtr->exportArrayPtr);
+	    ckfree((char *) nsPtr->exportArrayPtr);
 	    nsPtr->exportArrayPtr = NULL;
-	    TclInvalidateNsCmdLookup(nsPtr);
 	    nsPtr->numExportPatterns = 0;
 	    nsPtr->maxExportPatterns = 0;
 	}
@@ -1337,39 +935,49 @@ Tcl_Export(
 	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
-	Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
-		"\": pattern can't specify a namespace", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+	        "invalid export pattern \"", pattern,
+		"\": pattern can't specify a namespace",
+		(char *) 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 (neededElems > nsPtr->maxExportPatterns) {
-	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
-		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
-	nsPtr->exportArrayPtr = ckrealloc(nsPtr->exportArrayPtr,
-		sizeof(char *) * nsPtr->maxExportPatterns);
+    if (nsPtr->exportArrayPtr == NULL) {
+	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;
     }
 
     /*
@@ -1377,20 +985,11 @@ Tcl_Export(
      */
 
     len = strlen(pattern);
-    patternCpy = ckalloc(len + 1);
-    memcpy(patternCpy, pattern, (unsigned) len + 1);
-
+    patternCpy = (char *) ckalloc((unsigned) (len + 1));
+    strcpy(patternCpy, pattern);
+    
     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
 }
@@ -1406,24 +1005,24 @@ Tcl_Export(
  * 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(
-    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(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. */
 {
     Namespace *nsPtr;
     int i, result;
@@ -1433,9 +1032,9 @@ Tcl_AppendExportList(
      */
 
     if (namespacePtr == NULL) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+        nsPtr = (Namespace *) (Namespace *) Tcl_GetCurrentNamespace(interp);
     } else {
-	nsPtr = (Namespace *) namespacePtr;
+        nsPtr = (Namespace *) namespacePtr;
     }
 
     /*
@@ -1458,79 +1057,90 @@ Tcl_AppendExportList(
  * 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(
-    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(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. */
 {
+    Interp *iPtr = (Interp *) interp;
     Namespace *nsPtr, *importNsPtr, *dummyPtr;
-    const char *simplePattern;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    CONST char *simplePattern;
+    char *cmdName;
     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 *) TclGetCurrentNamespace(interp);
+        nsPtr = (Namespace *) currNsPtr;
     } 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.
-     *
-     * Note that we don't just call Tcl_EvalObjv() directly because we do not
-     * want absence of the command to be a failure case.
+     * 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.
      */
-
-    if (Tcl_FindCommand(interp,"auto_import",NULL,TCL_GLOBAL_ONLY) != NULL) {
+    
+    autoCmd = Tcl_FindCommand(interp, "auto_import",
+ 	    (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+ 
+    if (autoCmd != NULL) {
 	Tcl_Obj *objv[2];
-	int result;
-
-	TclNewLiteralStringObj(objv[0], "auto_import");
-	objv[1] = Tcl_NewStringObj(pattern, -1);
-
+ 
+	objv[0] = Tcl_NewStringObj("auto_import", -1);
 	Tcl_IncrRefCount(objv[0]);
+	objv[1] = Tcl_NewStringObj(pattern, -1);
 	Tcl_IncrRefCount(objv[1]);
-	result = Tcl_EvalObjv(interp, 2, objv, TCL_GLOBAL_ONLY);
+ 
+	cmdPtr = (Command *) autoCmd;
+	result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+		2, objv);
+ 
 	Tcl_DecrRefCount(objv[0]);
 	Tcl_DecrRefCount(objv[1]);
-
+ 
 	if (result != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -1538,38 +1148,38 @@ Tcl_Import(
     }
 
     /*
-     * 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_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
-        Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
-	return TCL_ERROR;
+	Tcl_SetStringObj(Tcl_GetObjResult(interp),
+	        "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_AppendResult(interp, "unknown namespace in import pattern \"",
-		pattern, "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
-	return TCL_ERROR;
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"unknown namespace in import pattern \"",
+		pattern, "\"", (char *) NULL);
+        return TCL_ERROR;
     }
     if (importNsPtr == nsPtr) {
 	if (pattern == simplePattern) {
-	    Tcl_AppendResult(interp,
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		    "no namespace specified in import pattern \"", pattern,
-		    "\"", NULL);
-            Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL);
+		    "\"", (char *) NULL);
 	} else {
-	    Tcl_AppendResult(interp, "import pattern \"", pattern,
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		    "import pattern \"", pattern,
 		    "\" tries to import from namespace \"",
-		    importNsPtr->name, "\" into itself", NULL);
-            Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL);
+		    importNsPtr->name, "\" into itself", (char *) NULL);
 	}
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
 
     /*
@@ -1579,158 +1189,118 @@ Tcl_Import(
      * 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)) {
-	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.
- *
- *----------------------------------------------------------------------
- */
-
-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;
-
-    /*
-     * The command cmdName in the source namespace matches the pattern. Check
-     * whether it was exported. If it wasn't, we ignore it.
-     */
-
-    while (!exported && (i < importNsPtr->numExportPatterns)) {
-	exported |= Tcl_StringMatch(cmdName,
-		importNsPtr->exportArrayPtr[i++]);
-    }
-    if (!exported) {
-	return TCL_OK;
-    }
-
-    /*
-     * Unless there is a name clash, create an imported command in the current
-     * namespace that refers to cmdPtr.
-     */
-
-    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.
-	 */
+	    (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;
+
+	    wasExported = 0;
+	    for (i = 0;  i < importNsPtr->numExportPatterns;  i++) {
+		if (Tcl_StringMatch(cmdName,
+			importNsPtr->exportArrayPtr[i])) {
+		    wasExported = 1;
+		    break;
+		}
+	    }
+	    if (!wasExported) {
+		continue;
+            }
 
-	Tcl_DString ds;
-	Tcl_Command importedCmd;
-	ImportedCmdData *dataPtr;
-	Command *cmdPtr;
-	ImportRef *refPtr;
+	    /*
+	     * 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 != ((Interp *) interp)->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;
 
-	cmdPtr = Tcl_GetHashValue(hPtr);
-	if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
-	    Command *overwrite = Tcl_GetHashValue(found);
-	    Command *linkCmd = cmdPtr;
-
-	    while (linkCmd->deleteProc == DeleteImportedCmd) {
-		dataPtr = linkCmd->objClientData;
-		linkCmd = dataPtr->realCmdPtr;
-		if (overwrite == linkCmd) {
-		    Tcl_AppendResult(interp, "import pattern \"", pattern,
-			    "\" would create a loop containing command \"",
-			    Tcl_DStringValue(&ds), "\"", NULL);
-		    Tcl_DStringFree(&ds);
-                    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
-		    return TCL_ERROR;
+		Tcl_DStringInit(&ds);
+		Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
+		if (nsPtr != iPtr->globalNsPtr) {
+		    Tcl_DStringAppend(&ds, "::", 2);
 		}
-	    }
-	}
-
-	dataPtr = ckalloc(sizeof(ImportedCmdData));
-	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
-		InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
-		DeleteImportedCmd);
-	dataPtr->realCmdPtr = cmdPtr;
-	dataPtr->selfPtr = (Command *) importedCmd;
-	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
-	Tcl_DStringFree(&ds);
+		Tcl_DStringAppend(&ds, cmdName, -1);
 
-	/*
-	 * Create an ImportRef structure describing this new import command
-	 * and add it to the import ref list in the "real" command.
-	 */
+		/*
+		 * Check whether creating the new imported command in the
+		 * current namespace would create a cycle of imported
+		 * command references.
+		 */
 
-	refPtr = ckalloc(sizeof(ImportRef));
-	refPtr->importedCmdPtr = (Command *) importedCmd;
-	refPtr->nextPtr = cmdPtr->importRefPtr;
-	cmdPtr->importRefPtr = refPtr;
-    } else {
-	Command *overwrite = Tcl_GetHashValue(found);
+		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;
+			}
+		    }
+		}
 
-	if (overwrite->deleteProc == DeleteImportedCmd) {
-	    ImportedCmdData *dataPtr = overwrite->objClientData;
+		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 (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) {
 		/*
-		 * Repeated import of same command is acceptable.
+		 * Create an ImportRef structure describing this new import
+		 * command and add it to the import ref list in the "real"
+		 * command.
 		 */
 
-		return TCL_OK;
-	    }
-	}
-	Tcl_AppendResult(interp, "can't import command \"", cmdName,
-		"\": already exists", NULL);
-        Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL);
-	return TCL_ERROR;
+                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;
 }
@@ -1740,39 +1310,40 @@ DoImport(
  *
  * 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(
-    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(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. */
 {
     Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
-    const char *simplePattern;
+    CONST char *simplePattern;
     char *cmdName;
     register Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
@@ -1782,14 +1353,14 @@ Tcl_ForgetImport(
      */
 
     if (namespacePtr == NULL) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+        nsPtr = (Namespace *) Tcl_GetCurrentNamespace(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,
@@ -1797,33 +1368,22 @@ Tcl_ForgetImport(
 	    &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
 
     if (sourceNsPtr == NULL) {
-	Tcl_AppendResult(interp,
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"unknown namespace in namespace forget pattern \"",
-		pattern, "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
-	return TCL_ERROR;
+		pattern, "\"", (char *) 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)) {
-	    hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
-	    if (hPtr != NULL) {
-		Command *cmdPtr = Tcl_GetHashValue(hPtr);
-
-		if (cmdPtr && (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 = Tcl_GetHashValue(hPtr);
-
+		(hPtr != NULL);
+		hPtr = Tcl_NextHashEntry(&search)) {
+	    Command *cmdPtr = (Command *) Tcl_GetHashValue(hPtr);
 	    if (cmdPtr->deleteProc != DeleteImportedCmd) {
 		continue;
 	    }
@@ -1835,29 +1395,26 @@ Tcl_ForgetImport(
 	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_GetHashValue(hPtr);
+	Tcl_Command token = (Tcl_Command) 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 = cmdPtr->objClientData;
+	    ImportedCmdData *dataPtr =
+		    (ImportedCmdData *) cmdPtr->objClientData;
 	    Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;
-
 	    if (firstToken == origin) {
 		continue;
 	    }
@@ -1867,7 +1424,7 @@ Tcl_ForgetImport(
 	    }
 	    origin = firstToken;
 	}
-	if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)){
+	if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)) {
 	    Tcl_DeleteCommandFromToken(interp, token);
 	}
     }
@@ -1881,15 +1438,15 @@ Tcl_ForgetImport(
  *
  *	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 function returns the original command it refers
- *	to.
+ *	imported command, this procedure 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 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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -1898,19 +1455,19 @@ Tcl_ForgetImport(
  */
 
 Tcl_Command
-TclGetOriginalCommand(
-    Tcl_Command command)	/* The imported command for which the original
-				 * command should be returned. */
+TclGetOriginalCommand(command)
+    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 NULL;
+	return (Tcl_Command) NULL;
     }
-
+    
     while (cmdPtr->deleteProc == DeleteImportedCmd) {
-	dataPtr = cmdPtr->objClientData;
+	dataPtr = (ImportedCmdData *) cmdPtr->objClientData;
 	cmdPtr = dataPtr->realCmdPtr;
     }
     return (Tcl_Command) cmdPtr;
@@ -1921,45 +1478,33 @@ TclGetOriginalCommand(
  *
  * 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
-InvokeImportedNRCmd(
-    ClientData clientData,	/* Points to the imported command's
+InvokeImportedCmd(clientData, interp, objc, objv)
+    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. */
 {
-    ImportedCmdData *dataPtr = clientData;
-    Command *realCmdPtr = dataPtr->realCmdPtr;
+    register ImportedCmdData *dataPtr = (ImportedCmdData *) clientData;
+    register Command *realCmdPtr = dataPtr->realCmdPtr;
 
-    ((Interp *) interp)->evalFlags |= TCL_EVAL_REDIRECT;
-    return Tcl_NRCmdSwap(interp, (Tcl_Command) realCmdPtr, objc, objv, 0);
-}
-
-static int
-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. */
-{
-    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
-	    objc, objv);
+    return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
+            objc, objv);
 }
 
 /*
@@ -1968,11 +1513,11 @@ InvokeImportedCmd(
  * 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 function 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 procedure removes the imported command reference from
+ *	the real command's list, and frees up the memory associated with
+ *	the imported command.
  *
  * Results:
  *	None.
@@ -1984,37 +1529,37 @@ InvokeImportedCmd(
  */
 
 static void
-DeleteImportedCmd(
-    ClientData clientData)	/* Points to the imported command's
+DeleteImportedCmd(clientData)
+    ClientData clientData;	/* Points to the imported command's
 				 * ImportedCmdData structure. */
 {
-    ImportedCmdData *dataPtr = clientData;
+    ImportedCmdData *dataPtr = (ImportedCmdData *) 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;
 	    }
-	    ckfree(refPtr);
-	    ckfree(dataPtr);
+	    ckfree((char *) refPtr);
+	    ckfree((char *) dataPtr);
 	    return;
 	}
 	prevPtr = refPtr;
     }
-
-    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
+	
+    panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
 }
 
 /*
@@ -2023,157 +1568,162 @@ DeleteImportedCmd(
  * TclGetNamespaceForQualName --
  *
  *	Given a qualified name specifying a command, variable, or namespace,
- *	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.
+ *	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.
  *
  *	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 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.
+ *	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.
  *
  * 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 function sets either *nsPtrPtr or *altNsPtrPtr
- *	to NULL, then the search along that path failed. The function also
+ *	qualified name. If the procedure sets either *nsPtrPtr or *altNsPtrPtr
+ *	to NULL, then the search along that path failed.  The procedure 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 (TCL_FIND_ONLY_NS), the function stores a pointer
+ *	namespace reference (FIND_ONLY_NS), the procedure 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 function returns TCL_ERROR. If "flags"
+ *	If there is an error, this procedure 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 TCL_CREATE_NS_IF_UNKNOWN, new namespaces may be
+ *	If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be
  *	created.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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. */
+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. */
 {
     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) {
-	nsPtr = iPtr->varFramePtr->nsPtr;
+	if (iPtr->varFramePtr != NULL) {
+	    nsPtr = iPtr->varFramePtr->nsPtr;
+	} else {
+	    nsPtr = iPtr->globalNsPtr;
+	}
     }
 
-    start = qualName;			/* Points to start of qualifying
-					 * namespace. */
+    start = qualName;		/* pts 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;
 
@@ -2186,8 +1736,8 @@ TclGetNamespaceForQualName(
 
     altNsPtr = globalNsPtr;
     if ((nsPtr == globalNsPtr)
-	    || (flags & (TCL_NAMESPACE_ONLY | TCL_FIND_ONLY_NS))) {
-	altNsPtr = NULL;
+	    || (flags & (TCL_NAMESPACE_ONLY | FIND_ONLY_NS))) {
+        altNsPtr = NULL;
     }
 
     /*
@@ -2197,37 +1747,38 @@ TclGetNamespaceForQualName(
     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 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.
+	     * 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.
 	     */
-
-	    if (flags & TCL_FIND_ONLY_NS) {
+	    
+	    if (flags & FIND_ONLY_NS) {
 		nsName = start;
 	    } else {
-		*nsPtrPtr = nsPtr;
-		*altNsPtrPtr = altNsPtr;
+		*nsPtrPtr      = nsPtr;
+		*altNsPtrPtr   = altNsPtr;
 		*simpleNamePtr = start;
 		Tcl_DStringFree(&buffer);
 		return TCL_OK;
@@ -2236,86 +1787,69 @@ TclGetNamespaceForQualName(
 	    /*
 	     * 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 TCL_CREATE_NS_IF_UNKNOWN is set,
-	 * create that qualifying namespace. This is needed for functions like
-	 * Tcl_CreateCommand that cannot fail.
+         * 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.
 	 */
 
-	if (nsPtr != NULL) {
-#ifndef BREAK_NAMESPACE_COMPAT
-	    entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
-#else
-	    if (nsPtr->childTablePtr == NULL) {
-		entryPtr = NULL;
-	    } else {
-		entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName);
-	    }
-#endif
-	    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;
-	    }
-	}
+        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.
-	 */
+        /*
+         * Look up the namespace qualifier in the alternate search path too.
+         */
 
-	if (altNsPtr != NULL) {
-#ifndef BREAK_NAMESPACE_COMPAT
-	    entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
-#else
-	    if (altNsPtr->childTablePtr != NULL) {
-		entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName);
-	    } else {
-		entryPtr = NULL;
-	    }
-#endif
-	    if (entryPtr != NULL) {
-		altNsPtr = Tcl_GetHashValue(entryPtr);
-	    } else {
-		altNsPtr = NULL;
-	    }
-	}
+        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 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 ((nsPtr == NULL) && (altNsPtr == NULL)) {
+            *nsPtrPtr      = NULL;
+            *altNsPtrPtr   = NULL;
+            *simpleNamePtr = NULL;
+            Tcl_DStringFree(&buffer);
+            return TCL_OK;
+        }
 
 	start = end;
     }
@@ -2325,26 +1859,26 @@ TclGetNamespaceForQualName(
      * variable name, trailing "::"s refer to the cmd or var named {}.
      */
 
-    if ((flags & TCL_FIND_ONLY_NS) || (end>start && *(end-1)!=':')) {
-	*simpleNamePtr = NULL;		/* Found namespace name. */
+    if ((flags & 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 & TCL_FIND_ONLY_NS) && (*qualName == '\0')
+    if ((flags & FIND_ONLY_NS) && (*qualName == '\0')
 	    && (nsPtr != globalNsPtr)) {
 	nsPtr = NULL;
     }
 
-    *nsPtrPtr = nsPtr;
+    *nsPtrPtr    = nsPtr;
     *altNsPtrPtr = altNsPtr;
     Tcl_DStringFree(&buffer);
     return TCL_OK;
@@ -2358,9 +1892,9 @@ TclGetNamespaceForQualName(
  *	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.
@@ -2369,43 +1903,41 @@ TclGetNamespaceForQualName(
  */
 
 Tcl_Namespace *
-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. */
+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. */
 {
     Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
-    const char *dummy;
+    CONST char *dummy;
 
     /*
-     * 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.
+     * 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.
      */
 
     TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
-	    flags|TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
-
+	    (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+    
     if (nsPtr != NULL) {
-	return (Tcl_Namespace *) nsPtr;
-    }
-
-    if (flags & TCL_LEAVE_ERR_MSG) {
+       return (Tcl_Namespace *) nsPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
 	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "unknown namespace \"", name, "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown namespace \"", name, "\"", (char *) NULL);
     }
     return NULL;
 }
@@ -2418,10 +1950,10 @@ Tcl_FindNamespace(
  *	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.
@@ -2430,171 +1962,244 @@ Tcl_FindNamespace(
  */
 
 Tcl_Command
-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;
+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;
     register Tcl_HashEntry *entryPtr;
     register Command *cmdPtr;
-    const char *simpleName;
+    register int search;
     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 functions 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
+     * procedures may return a Tcl_Command value, they may signal
+     * to continue onward, or they may signal an error.
      */
-
-    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 ((flags & TCL_GLOBAL_ONLY) != 0) {
+        cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    }
+    else if (contextNsPtr != NULL) {
+        cxtNsPtr = (Namespace *) contextNsPtr;
+    }
+    else {
+        cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
     }
 
     if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
-	ResolverScheme *resPtr = iPtr->resolverPtr;
-	Tcl_Command cmd;
+        resPtr = iPtr->resolverPtr;
 
-	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 NULL;
-	}
+        if (result == TCL_OK) {
+            return cmd;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Command) 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;
-    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);
-		}
+    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);
 	    }
 	}
+    }
 
-	/*
-	 * Next, check along the path.
-	 */
+    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);
+    }
 
-	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);
-		}
-	    }
-	}
+    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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	/*
-	 * If we've still not found the command, look in the global namespace
-	 * as a last resort.
-	 */
+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;
 
-	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 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);
+    }
 
-	TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
-		flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+    if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+        resPtr = iPtr->resolverPtr;
 
-	/*
-	 * 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 (cxtNsPtr->varResProc) {
+            result = (*cxtNsPtr->varResProc)(interp, name,
+                (Tcl_Namespace *) cxtNsPtr, flags, &var);
+        } else {
+            result = TCL_CONTINUE;
+        }
 
-	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);
-		}
-	    }
-	}
-    }
+        while (result == TCL_CONTINUE && resPtr) {
+            if (resPtr->varResProc) {
+                result = (*resPtr->varResProc)(interp, name,
+                    (Tcl_Namespace *) cxtNsPtr, flags, &var);
+            }
+            resPtr = resPtr->nextPtr;
+        }
 
-    if (cmdPtr != NULL) {
-	return (Tcl_Command) cmdPtr;
+        if (result == TCL_OK) {
+            return var;
+        }
+        else if (result != TCL_CONTINUE) {
+            return (Tcl_Var) NULL;
+        }
     }
 
-    if (flags & TCL_LEAVE_ERR_MSG) {
+    /*
+     * 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 (varPtr != NULL) {
+	return (Tcl_Var) varPtr;
+    } else if (flags & TCL_LEAVE_ERR_MSG) {
 	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "unknown command \"", name, "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+                "unknown variable \"", name, "\"", (char *) NULL);
     }
-    return NULL;
+    return (Tcl_Var) NULL;
 }
 
 /*
@@ -2606,49 +2211,56 @@ Tcl_FindCommand(
  *	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(
-    Tcl_Interp *interp,		/* Interpreter containing the new command. */
-    Command *newCmdPtr)		/* Points to the new command. */
+TclResetShadowedCmdRefs(interp, newCmdPtr)
+    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 *) TclGetGlobalNamespace(interp);
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(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 = 5;		/* Formerly NUM_TRAIL_ELEMS. */
-    Namespace **trailPtr = TclStackAlloc(interp,
-	    trailSize * sizeof(Namespace *));
+    int trailSize = NUM_TRAIL_ELEMS;
 
     /*
-     * 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
@@ -2656,198 +2268,326 @@ TclResetShadowedCmdRefs(
      * 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];
-#ifndef BREAK_NAMESPACE_COMPAT
-	    hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
+        for (i = trailFront;  i >= 0;  i--) {
+            trailNsPtr = trailPtr[i];
+            hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
 		    trailNsPtr->name);
-#else
-	    if (shadowNsPtr->childTablePtr != NULL) {
-		hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr,
-			trailNsPtr->name);
-	    } else {
-		hPtr = NULL;
-	    }
-#endif
-	    if (hPtr != NULL) {
-		shadowNsPtr = Tcl_GetHashValue(hPtr);
-	    } else {
-		found = 0;
-		break;
-	    }
-	}
+            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 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++;
-		TclInvalidateNsPath(nsPtr);
+        if (found) {
+            hPtr = Tcl_FindHashEntry(&shadowNsPtr->cmdTable, cmdName);
+            if (hPtr != NULL) {
+                nsPtr->cmdRefEpoch++;
 
-		/*
+		/* 
 		 * 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) {
-	    int newSize = 2 * trailSize;
-
-	    trailPtr = TclStackRealloc(interp, trailPtr,
-		    newSize * sizeof(Namespace *));
+	    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;
 	    trailSize = newSize;
 	}
 	trailPtr[trailFront] = nsPtr;
     }
-    TclStackFree(interp, trailPtr);
+
+    /*
+     * Free any allocated storage.
+     */
+    
+    if (trailPtr != trailStorage) {
+	ckfree((char *) trailPtr);
+    }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclGetNamespaceFromObj, GetNamespaceFromObj --
+ * 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, or anything else goes wrong, this
- *	function returns TCL_ERROR and writes an error message to interp,
- *	if non-NULL.
+ *	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.
  *
  * Side effects:
  *	May update the internal representation for the object, caching the
- *	namespace reference. The next time this function is called, the
+ *	namespace reference. The next time this procedure is called, the
  *	namespace value can be found quickly.
  *
+ *	If anything goes wrong, an error message is left in the
+ *	interpreter's result object.
+ *
  *----------------------------------------------------------------------
  */
 
-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. */
+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. */
 {
-    if (GetNamespaceFromObj(interp, objPtr, nsPtrPtr) == TCL_ERROR) {
-	const char *name = TclGetString(objPtr);
+    Interp *iPtr = (Interp *) interp;
+    register ResolvedNsName *resNamePtr;
+    register Namespace *nsPtr;
+    Namespace *currNsPtr;
+    CallFrame *savedFramePtr;
+    int result = TCL_OK;
+    char *name;
 
-	if ((name[0] == ':') && (name[1] == ':')) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "namespace \"%s\" not found", name));
-	} else {
-	    /*
-	     * Get the current namespace name.
-	     */
+    /*
+     * 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. 
+     */
 
-	    NamespaceCurrentCmd(NULL, interp, 1, 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;
+    savedFramePtr = iPtr->varFramePtr;
+    name = Tcl_GetString(objPtr);
+    if ((*name++ == ':') && (*name == ':')) {
+	iPtr->varFramePtr = NULL;
     }
-    return TCL_OK;
-}
 
-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;
+    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 == &nsNameType) {
-	/*
-	 * Check that the ResolvedNsName is still valid; avoid letting the ref
-	 * cross interps.
-	 */
+    if (objPtr->typePtr != &tclNsNameType) {
+        result = tclNsNameType.setFromAnyProc(interp, objPtr);
+        if (result != TCL_OK) {
+	    goto done;
+        }
+    }
+    resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
 
-	resNamePtr = 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;
+    /*
+     * 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.
+     */
+
+    nsPtr = NULL;
+    if ((resNamePtr != NULL)
+	    && (resNamePtr->refNsPtr == currNsPtr)
+	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+        nsPtr = resNamePtr->nsPtr;
+	if (nsPtr->flags & NS_DEAD) {
+	    nsPtr = NULL;
 	}
     }
-    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
-	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
-	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
-	return TCL_OK;
+    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;
+            }
+        }
     }
-    return TCL_ERROR;
+    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
+
+    done:
+    iPtr->varFramePtr = savedFramePtr;
+    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclInitNamespaceCmd --
+ * Tcl_NamespaceObjCmd --
  *
- *	This function is called to create the "namespace" Tcl command. See the
- *	user documentation for details on what it does.
+ *	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 eval name arg ?arg...?
+ *	    namespace exists name
+ *	    namespace export ?-clear? ?pattern pattern...?
+ *	    namespace forget ?pattern pattern...?
+ *	    namespace import ?-force? ?pattern pattern...?
+ *	    namespace inscope name arg ?arg...?
+ *	    namespace origin name
+ *	    namespace parent ?name?
+ *	    namespace qualifiers string
+ *	    namespace tail string
+ *	    namespace which ?-command? ?-variable? name
  *
  * Results:
- *	Handle for the namespace command, or NULL on failure.
+ *	Returns TCL_OK if the command is successful. Returns TCL_ERROR if
+ *	anything goes wrong.
  *
  * Side effects:
- *	none
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Command
-TclInitNamespaceCmd(
-    Tcl_Interp *interp)		/* Current interpreter. */
-{
-    return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap);
+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",
+	"eval", "exists", "export", "forget", "import",
+	"inscope", "origin", "parent", "qualifiers",
+	"tail", "which", (char *) NULL
+    };
+    enum NSSubCmdIdx {
+	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx,
+	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
+	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSQualifiersIdx,
+	NSTailIdx, NSWhichIdx
+    };
+    int index, result;
+
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
+        return TCL_ERROR;
+    }
+
+    /*
+     * Return an index reflecting the particular subcommand.
+     */
+
+    result = Tcl_GetIndexFromObj((Tcl_Interp *) interp, objv[1], subCmds,
+	    "option", /*flags*/ 0, (int *) &index);
+    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;
+    }
+    return result;
 }
 
 /*
@@ -2856,8 +2596,8 @@ TclInitNamespaceCmd(
  * 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?
  *
@@ -2865,23 +2605,23 @@ TclInitNamespaceCmd(
  *	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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Tcl_Namespace *namespacePtr;
     Namespace *nsPtr, *childNsPtr;
-    Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
-    const char *pattern = NULL;
+    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
+    char *pattern = NULL;
     Tcl_DString buffer;
     register Tcl_HashEntry *entryPtr;
     Tcl_HashSearch search;
@@ -2891,16 +2631,22 @@ NamespaceChildrenCmd(
      * Get a pointer to the specified namespace, or the current namespace.
      */
 
-    if (objc == 1) {
-	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    } else if ((objc == 2) || (objc == 3)) {
-	if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK){
-	    return TCL_ERROR;
-	}
-	nsPtr = (Namespace *) namespacePtr;
+    if (objc == 2) {
+	nsPtr = (Namespace *) Tcl_GetCurrentNamespace(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;
     } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?name? ?pattern?");
-	return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
+        return TCL_ERROR;
     }
 
     /*
@@ -2908,65 +2654,38 @@ NamespaceChildrenCmd(
      */
 
     Tcl_DStringInit(&buffer);
-    if (objc == 3) {
-	const char *name = TclGetString(objv[2]);
-
-	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);
-	}
+    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);
+        }
     }
 
     /*
-     * 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, NULL);
-    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
-	unsigned int length = strlen(nsPtr->fullName);
-
-	if (strncmp(pattern, nsPtr->fullName, length) != 0) {
-	    goto searchDone;
-	}
-	if (
-#ifndef BREAK_NAMESPACE_COMPAT
-	    Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL
-#else
-	    nsPtr->childTablePtr != NULL &&
-	    Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL
-#endif
-	) {
-	    Tcl_ListObjAppendElement(interp, listPtr,
-		    Tcl_NewStringObj(pattern, -1));
-	}
-	goto searchDone;
-    }
-#ifndef BREAK_NAMESPACE_COMPAT
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
     entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-#else
-    if (nsPtr->childTablePtr == NULL) {
-	goto searchDone;
-    }
-    entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
-#endif
     while (entryPtr != NULL) {
-	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);
+        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);
     }
 
-  searchDone:
     Tcl_SetObjResult(interp, listPtr);
     Tcl_DStringFree(&buffer);
     return TCL_OK;
@@ -2987,74 +2706,80 @@ NamespaceChildrenCmd(
  *
  *	    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 function returns an error message as the
- *	result in the interpreter's result object.
+ *	If anything goes wrong, this procedure returns an error
+ *	message as the result in the interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceCodeCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Namespace *currNsPtr;
     Tcl_Obj *listPtr, *objPtr;
-    register const char *arg;
+    register char *arg, *p;
     int length;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arg");
-	return TCL_ERROR;
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "arg");
+        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 = TclGetStringFromObj(objv[1], &length);
-    if (*arg==':' && length > 20 
-	    && strncmp(arg, "::namespace inscope ", 20) == 0) {
-	Tcl_SetObjResult(interp, objv[1]);
-	return TCL_OK;
+    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;
+	}
     }
 
     /*
      * 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.
      */
 
-    TclNewObj(listPtr);
-    TclNewLiteralStringObj(objPtr, "::namespace");
-    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
-    TclNewLiteralStringObj(objPtr, "inscope");
-    Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+    listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+    Tcl_ListObjAppendElement(interp, listPtr,
+            Tcl_NewStringObj("::namespace", -1));
+    Tcl_ListObjAppendElement(interp, listPtr,
+	    Tcl_NewStringObj("inscope", -1));
 
-    currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
-	TclNewLiteralStringObj(objPtr, "::");
+    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
+	objPtr = Tcl_NewStringObj("::", -1);
     } else {
 	objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
     }
     Tcl_ListObjAppendElement(interp, listPtr, objPtr);
-
-    Tcl_ListObjAppendElement(interp, listPtr, objv[1]);
+    
+    Tcl_ListObjAppendElement(interp, listPtr, objv[2]);
 
     Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
@@ -3065,9 +2790,9 @@ NamespaceCodeCmd(
  *
  * 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
  *
@@ -3075,40 +2800,40 @@ NamespaceCodeCmd(
  *	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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     register Namespace *currNsPtr;
 
-    if (objc != 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, NULL);
-	return TCL_ERROR;
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 2, objv, NULL);
+        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 *) TclGetCurrentNamespace(interp);
-    if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2));
+    currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+    if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) {
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), "::", -1);
     } else {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1));
+	Tcl_AppendToObj(Tcl_GetObjResult(interp), currNsPtr->fullName, -1);
     }
     return TCL_OK;
 }
@@ -3126,70 +2851,70 @@ NamespaceCurrentCmd(
  *	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
- *	function returns an error. If no namespaces are specified, this
+ *	procedure 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
- *	function returns an error message in the interpreter's result object.
+ *	procedure returns an error message in the interpreter's
+ *	result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceDeleteCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Tcl_Namespace *namespacePtr;
-    const char *name;
+    char *name;
     register int i;
 
-    if (objc < 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
-	return TCL_ERROR;
+    if (objc < 2) {
+        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 = 1;  i < objc;  i++) {
-	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;
-	}
+    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;
+        }
     }
 
     /*
      * Okay, now delete each namespace.
      */
 
-    for (i = 1;  i < objc;  i++) {
-	name = TclGetString(objv[i]);
-	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0);
+    for (i = 2;  i < objc;  i++) {
+        name = Tcl_GetString(objv[i]);
+	namespacePtr = Tcl_FindNamespace(interp, name,
+	    (Tcl_Namespace *) NULL, /* flags */ 0);
 	if (namespacePtr) {
-	    Tcl_DeleteNamespace(namespacePtr);
-	}
+            Tcl_DeleteNamespace(namespacePtr);
+        }
     }
     return TCL_OK;
 }
@@ -3199,57 +2924,44 @@ NamespaceDeleteCmd(
  *
  * 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 function returns an error message as the
- *	result.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceEvalCmd(
-    ClientData clientData,	/* Arbitrary value passed to cmd. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc,
-	    objv);
-}
-
-static int
-NRNamespaceEvalCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Interp *iPtr = (Interp *) interp;
-    CmdFrame *invoker;
-    int word;
     Tcl_Namespace *namespacePtr;
-    CallFrame *framePtr, **framePtrPtr;
+    CallFrame frame;
     Tcl_Obj *objPtr;
-    int result;
+    char *name;
+    int length, result;
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
-	return TCL_ERROR;
+    if (objc < 4) {
+        Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+        return TCL_ERROR;
     }
 
     /*
@@ -3257,99 +2969,75 @@ NRNamespaceEvalCmd(
      * namespace object along the way.
      */
 
-    result = GetNamespaceFromObj(interp, objv[1], &namespacePtr);
+    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);
+    if (result != TCL_OK) {
+        return result;
+    }
 
     /*
      * If the namespace wasn't found, try to create it.
      */
-
-    if (result == TCL_ERROR) {
-	const char *name = TclGetString(objv[1]);
-
-	namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL);
+    
+    if (namespacePtr == NULL) {
+	name = Tcl_GetStringFromObj(objv[2], &length);
+	namespacePtr = Tcl_CreateNamespace(interp, name, (ClientData) NULL, 
+                (Tcl_NamespaceDeleteProc *) 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).
      */
 
-    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
-    framePtrPtr = &framePtr;
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
-	    namespacePtr, /*isProcCallFrame*/ 0);
+    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) &frame, 
+            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 */
 
-    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
-        framePtr->objc = objc;
-        framePtr->objv = objv;
-    } else {
-        framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
-                - iPtr->ensembleRewrite.numInsertedObjs;
-        framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
-    }
-
-    if (objc == 3) {
-	/*
-	 * TIP #280: Make actual argument location available to eval'd script.
-	 */
-
-	objPtr = objv[2];
-	invoker = iPtr->cmdFramePtr;
-	word = 3;
-	TclArgumentGet(interp, objPtr, &invoker, &word);
+    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;
+	CmdFrame* invoker = iPtr->cmdFramePtr;
+	int word          = 3;
+	TclArgumentGet (interp, objv[3], &invoker, &word);
+        result = TclEvalObjEx(interp, objv[3], 0, invoker, word);
+#endif
     } 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-2, objv+2);
-	invoker = NULL;
-	word = 0;
+        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 */
+	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
+#endif
     }
-
-    /*
-     * TIP #280: Make invoking context available to eval'd script.
-     */
-
-    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
-	    NULL, NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
-}
-
-static int
-NsEval_Callback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Namespace *namespacePtr = data[0];
-
     if (result == TCL_ERROR) {
-	int length = strlen(namespacePtr->fullName);
-	int limit = 200;
-	int overflow = (length > limit);
-	char *cmd = data[1];
-
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (in namespace %s \"%.*s%s\" script line %d)",
-		cmd,
-		(overflow ? limit : length), namespacePtr->fullName,
-		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
+        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);
     }
 
     /*
      * Restore the previous "current" namespace.
      */
-
-    TclPopStackFrame(interp);
+    
+    Tcl_PopCallFrame(interp);
     return result;
 }
 
@@ -3358,9 +3046,9 @@ NsEval_Callback(
  *
  * 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
  *
@@ -3368,28 +3056,35 @@ NsEval_Callback(
  *	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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Tcl_Namespace *namespacePtr;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "name");
+        return TCL_ERROR;
     }
 
-    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
-	    GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
+    /*
+     * Check whether the given namespace exists
+     */
+
+    if (GetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (namespacePtr != NULL));
     return TCL_OK;
 }
 
@@ -3400,18 +3095,18 @@ NamespaceExistsCmd(
  *
  *	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.
@@ -3423,36 +3118,37 @@ NamespaceExistsCmd(
  *	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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
-    const char *pattern, *string;
+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. */
+{
+    Namespace *currNsPtr = (Namespace*) Tcl_GetCurrentNamespace(interp);
+    char *pattern, *string;
     int resetListFirst = 0;
     int firstArg, patternCt, i, result;
 
-    if (objc < 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
-	return TCL_ERROR;
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 2, objv,
+	        "?-clear? ?pattern pattern...?");
+        return TCL_ERROR;
     }
 
     /*
      * Process the optional "-clear" argument.
      */
 
-    firstArg = 1;
+    firstArg = 2;
     if (firstArg < objc) {
-	string = TclGetString(objv[firstArg]);
+	string = Tcl_GetString(objv[firstArg]);
 	if (strcmp(string, "-clear") == 0) {
 	    resetListFirst = 1;
 	    firstArg++;
@@ -3460,23 +3156,18 @@ NamespaceExportCmd(
     }
 
     /*
-     * 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;
+    patternCt = (objc - firstArg);
     if (patternCt == 0) {
-	if (firstArg > 1) {
+	if (firstArg > 2) {
 	    return TCL_OK;
-	} else {
-	    /*
-	     * Create list with export patterns.
-	     */
-
-	    Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
-
-	    result = Tcl_AppendExportList(interp, (Tcl_Namespace *) currNsPtr,
-		    listPtr);
+	} else {		/* create list with export patterns */
+	    Tcl_Obj *listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+	    result = Tcl_AppendExportList(interp,
+		    (Tcl_Namespace *) currNsPtr, listPtr);
 	    if (result != TCL_OK) {
 		return result;
 	    }
@@ -3488,14 +3179,14 @@ NamespaceExportCmd(
     /*
      * Add each pattern to the namespace's export pattern list.
      */
-
+    
     for (i = firstArg;  i < objc;  i++) {
-	pattern = TclGetString(objv[i]);
+	pattern = Tcl_GetString(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;
 }
@@ -3505,52 +3196,52 @@ NamespaceExportCmd(
  *
  * 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 function returns an error message in the
+ *	Imported commands are removed from the current namespace. If
+ *	anything goes wrong, this procedure returns an error message in the
  *	interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceForgetCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *pattern;
+    char *pattern;
     register int i, result;
 
-    if (objc < 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
-	return TCL_ERROR;
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
+        return TCL_ERROR;
     }
 
-    for (i = 1;  i < objc;  i++) {
-	pattern = TclGetString(objv[i]);
-	result = Tcl_ForgetImport(interp, NULL, pattern);
-	if (result != TCL_OK) {
-	    return result;
-	}
+    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;
+        }
     }
     return TCL_OK;
 }
@@ -3565,87 +3256,62 @@ NamespaceForgetCmd(
  *
  *	    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 function returns an error message in the interpreter's
+ *	wrong, this procedure returns an error message in the interpreter's
  *	result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceImportCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int allowOverwrite = 0;
-    const char *string, *pattern;
+    char *string, *pattern;
     register int i, result;
     int firstArg;
 
-    if (objc < 1) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
-	return TCL_ERROR;
+    if (objc < 2) {
+        Tcl_WrongNumArgs(interp, 2, objv,
+	        "?-force? ?pattern pattern...?");
+        return TCL_ERROR;
     }
 
     /*
      * Skip over the optional "-force" as the first argument.
      */
 
-    firstArg = 1;
+    firstArg = 2;
     if (firstArg < objc) {
-	string = TclGetString(objv[firstArg]);
+	string = Tcl_GetString(objv[firstArg]);
 	if ((*string == '-') && (strcmp(string, "-force") == 0)) {
 	    allowOverwrite = 1;
 	    firstArg++;
 	}
-    } else {
-	/*
-	 * When objc == 1, 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;
     }
 
     /*
@@ -3653,11 +3319,12 @@ NamespaceImportCmd(
      */
 
     for (i = firstArg;  i < objc;  i++) {
-	pattern = TclGetString(objv[i]);
-	result = Tcl_Import(interp, NULL, pattern, allowOverwrite);
-	if (result != TCL_OK) {
-	    return result;
-	}
+        pattern = Tcl_GetString(objv[i]);
+	result = Tcl_Import(interp, (Tcl_Namespace *) NULL, pattern,
+	        allowOverwrite);
+        if (result != TCL_OK) {
+            return result;
+        }
     }
     return TCL_OK;
 }
@@ -3669,29 +3336,30 @@ NamespaceImportCmd(
  *
  *	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 e
+ *	    namespace inscope ::foo a b c d
  *
  *	is equivalent to
  *
- *	    namespace eval ::foo [concat {a b} [list c d e]]
+ *	    namespace eval ::foo [concat a [list b c d]]
  *
- *	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.
@@ -3700,93 +3368,89 @@ NamespaceImportCmd(
  */
 
 static int
-NamespaceInscopeCmd(
-    ClientData clientData,	/* Arbitrary value passed to cmd. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc,
-	    objv);
-}
-
-static int
-NRNamespaceInscopeCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Tcl_Namespace *namespacePtr;
-    CallFrame *framePtr, **framePtrPtr;
-    register Interp *iPtr = (Interp *) interp;
+    Tcl_CallFrame frame;
     int i, result;
-    Tcl_Obj *cmdObjPtr;
 
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
-	return TCL_ERROR;
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
+        return TCL_ERROR;
     }
 
     /*
      * Resolve the namespace reference.
      */
 
-    if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) {
-	return TCL_ERROR;
+    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;
     }
 
     /*
      * Make the specified namespace the current namespace.
      */
 
-    framePtrPtr = &framePtr;		/* This is needed to satisfy GCC's
-					 * strict aliasing rules. */
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
-	    namespacePtr, /*isProcCallFrame*/ 0);
+    result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+	    /*isProcCallFrame*/ 0);
     if (result != TCL_OK) {
-	return result;
-    }
-
-    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
-        framePtr->objc = objc;
-        framePtr->objv = objv;
-    } else {
-        framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
-                - iPtr->ensembleRewrite.numInsertedObjs;
-        framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
+        return result;
     }
 
     /*
-     * 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 == 3) {
-	cmdObjPtr = objv[2];
+    if (objc == 4) {
+        result = Tcl_EvalObjEx(interp, objv[3], 0);
     } else {
 	Tcl_Obj *concatObjv[2];
-	register Tcl_Obj *listPtr;
-
-	listPtr = Tcl_NewListObj(0, NULL);
-	for (i = 3;  i < objc;  i++) {
-	    if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){
-		Tcl_DecrRefCount(listPtr);	/* Free unneeded obj. */
-		return TCL_ERROR;
-	    }
-	}
+	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;
+            }
+        }
 
-	concatObjv[0] = objv[2];
+	concatObjv[0] = objv[3];
 	concatObjv[1] = listPtr;
 	cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
-	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);
     }
 
-    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
-	    NULL, NULL);
-    return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);
+    /*
+     * Restore the previous "current" namespace.
+     */
+
+    Tcl_PopCallFrame(interp);
+    return result;
 }
 
 /*
@@ -3808,53 +3472,49 @@ NRNamespaceInscopeCmd(
  *	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 function returns TCL_OK if
+ *	interpreter's result object. This procedure returns TCL_OK if
  *	successful, and TCL_ERROR if anything goes wrong.
  *
  * Side effects:
- *	If anything goes wrong, this function returns an error message in the
- *	interpreter's result object.
+ *	If anything goes wrong, this procedure returns an error message in
+ *	the interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-NamespaceOriginCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Tcl_Command command, origCommand;
-    Tcl_Obj *resultPtr;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name");
-	return TCL_ERROR;
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 2, objv, "name");
+        return TCL_ERROR;
     }
 
-    command = Tcl_GetCommandFromObj(interp, objv[1]);
-    if (command == NULL) {
-	Tcl_AppendResult(interp, "invalid command name \"",
-		TclGetString(objv[1]), "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
-		TclGetString(objv[1]), NULL);
+    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);
 	return TCL_ERROR;
     }
     origCommand = TclGetOriginalCommand(command);
-    TclNewObj(resultPtr);
-    if (origCommand == NULL) {
+    if (origCommand == (Tcl_Command) 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, resultPtr);
+	
+	Tcl_GetCommandFullName(interp, command, Tcl_GetObjResult(interp));
     } else {
-	Tcl_GetCommandFullName(interp, origCommand, resultPtr);
+	Tcl_GetCommandFullName(interp, origCommand, Tcl_GetObjResult(interp));
     }
-    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
@@ -3873,30 +3533,38 @@ NamespaceOriginCmd(
  *	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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Tcl_Namespace *nsPtr;
+    int result;
 
-    if (objc == 1) {
-	nsPtr = TclGetCurrentNamespace(interp);
-    } else if (objc == 2) {
-	if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+    if (objc == 2) {
+        nsPtr = Tcl_GetCurrentNamespace(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;
+        }
     } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
-	return TCL_ERROR;
+        Tcl_WrongNumArgs(interp, 2, objv, "?name?");
+        return TCL_ERROR;
     }
 
     /*
@@ -3904,8 +3572,8 @@ NamespaceParentCmd(
      */
 
     if (nsPtr->parentPtr != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		nsPtr->parentPtr->fullName, -1));
+        Tcl_SetStringObj(Tcl_GetObjResult(interp),
+	        nsPtr->parentPtr->fullName, -1);
     }
     return TCL_OK;
 }
@@ -3913,480 +3581,66 @@ NamespaceParentCmd(
 /*
  *----------------------------------------------------------------------
  *
- * 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 > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * If no path is given, return the current path.
-     */
-
-    if (objc == 1) {
-        Tcl_Obj *resultObj = Tcl_NewObj();
-
-	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
-	    if (nsPtr->commandPathArray[i].nsPtr != NULL) {
-                Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
-                        nsPtr->commandPathArray[i].nsPtr->fullName, -1));
-	    }
-	}
-        Tcl_SetObjResult(interp, resultObj);
-	return TCL_OK;
-    }
-
-    /*
-     * There is a path given, so parse it into an array of namespace pointers.
-     */
-
-    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
-	goto badNamespace;
-    }
-    if (nsObjc != 0) {
-	namespaceList = 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 =
-		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(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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    register const char *name, *p;
+    register char *name, *p;
     int length;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string");
-	return TCL_ERROR;
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "string");
+        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 = TclGetString(objv[1]);
+    name = Tcl_GetString(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_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 > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?script?");
-	return TCL_ERROR;
-    }
-
-    currNsPtr = TclGetCurrentNamespace(interp);
-
-    if (objc == 1) {
-	/*
-	 * 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[1]);
-	if (rc == TCL_OK) {
-	    Tcl_SetObjResult(interp, objv[1]);
-	}
-	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;
+        length = p-name+1;
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), name, length);
     }
     return TCL_OK;
 }
@@ -4397,13 +3651,13 @@ Tcl_SetNamespaceUnknownHandler(
  * 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
  *
@@ -4411,119 +3665,45 @@ Tcl_SetNamespaceUnknownHandler(
  *	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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    register const char *name, *p;
+    register char *name, *p;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "string");
-	return TCL_ERROR;
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 2, objv, "string");
+        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 = TclGetString(objv[1]);
+    name = Tcl_GetString(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_SetObjResult(interp, Tcl_NewStringObj(p, -1));
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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;
-    const char *myName;
-
-    if (objc < 2 || (objc & 1)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?");
-	return TCL_ERROR;
-    }
-
-    if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
-	return TCL_ERROR;
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), p, -1);
     }
-
-    objc -= 2;
-    objv += 2;
-
-    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;
 }
 
@@ -4543,66 +3723,70 @@ NamespaceUpvarCmd(
  *	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(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    static const char *const opts[] = {
-	"-command", "-variable", NULL
-    };
-    int lookupType = 0;
-    Tcl_Obj *resultPtr;
+    register char *arg;
+    Tcl_Command cmd;
+    Tcl_Var variable;
+    int argIndex, lookup;
 
-    if (objc < 2 || objc > 3) {
-    badArgs:
-	Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
-	return TCL_ERROR;
-    } else if (objc == 3) {
-	/*
-	 * Look for a flag controlling the lookup.
-	 */
+    if (objc < 3) {
+        badArgs:
+        Tcl_WrongNumArgs(interp, 2, objv,
+	        "?-command? ?-variable? name");
+        return TCL_ERROR;
+    }
 
-	if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
-		&lookupType) != TCL_OK) {
-	    /*
-	     * Preserve old style of error message!
-	     */
+    /*
+     * Look for a flag controlling the lookup.
+     */
 
-	    Tcl_ResetResult(interp);
+    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 {
 	    goto badArgs;
 	}
+	argIndex = 3;
     }
-
-    TclNewObj(resultPtr);
-    switch (lookupType) {
-    case 0: {				/* -command */
-	Tcl_Command cmd = Tcl_GetCommandFromObj(interp, objv[objc-1]);
-
-	if (cmd != NULL) {
-	    Tcl_GetCommandFullName(interp, cmd, resultPtr);
-	}
-	break;
+    if (objc != (argIndex + 1)) {
+	goto badArgs;
     }
-    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;
-    }
+    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;
+
+    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;
     }
-    Tcl_SetObjResult(interp, resultPtr);
     return TCL_OK;
 }
 
@@ -4618,37 +3802,45 @@ NamespaceWhichCmd(
  *	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(
-    register Tcl_Obj *objPtr)	/* nsName object with internal representation
-				 * to free. */
+FreeNsNameInternalRep(objPtr)
+    register Tcl_Obj *objPtr;   /* nsName object with internal
+                                 * representation to free */
 {
-    ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    register ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    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.
      */
 
-    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.
-	 */
+    if (resNamePtr != NULL) {
+        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.
+	     */
 
-	TclNsDecrRefCount(resNamePtr->nsPtr);
-	ckfree(resNamePtr);
+            nsPtr = resNamePtr->nsPtr;
+            nsPtr->refCount--;
+            if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+                NamespaceFree(nsPtr);
+            }
+            ckfree((char *) resNamePtr);
+        }
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -4664,22 +3856,25 @@ FreeNsNameInternalRep(
  *
  * 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(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
+DupNsNameInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;                /* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;      /* Object with internal rep to set. */
 {
-    ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    register ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) srcPtr->internalRep.otherValuePtr;
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
-    resNamePtr->refCount++;
-    copyPtr->typePtr = &nsNameType;
+    copyPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
+    if (resNamePtr != NULL) {
+        resNamePtr->refCount++;
+    }
+    copyPtr->typePtr = &tclNsNameType;
 }
 
 /*
@@ -4687,385 +3882,146 @@ DupNsNameInternalRep(
  *
  * 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(
-    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. */
-{
-    const char *dummy;
+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. */
+{
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *name;
+    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.
+     */
+
+    name = objPtr->bytes;
+    if (name == NULL) {
+	name = Tcl_GetString(objPtr);
+    }
 
     /*
-     * If we found a namespace, then create a new ResolvedNsName structure
-     * that holds a reference to it.
+     * 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.
      */
 
-    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.
-	 */
+    TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
+            FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
 
-	if (objPtr->typePtr == &nsNameType) {
-	    TclFreeIntRep(objPtr);
-	}
-	return TCL_ERROR;
-    }
+    /*
+     * If we found a namespace, then create a new ResolvedNsName structure
+     * that holds a reference to it.
+     */
 
-    nsPtr->refCount++;
-    resNamePtr = ckalloc(sizeof(ResolvedNsName));
-    resNamePtr->nsPtr = nsPtr;
-    if ((name[0] == ':') && (name[1] == ':')) {
-	resNamePtr->refNsPtr = NULL;
+    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->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+        resNamePtr = NULL;
     }
-    resNamePtr->refCount = 1;
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
-    objPtr->typePtr = &nsNameType;
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetNamespaceCommandTable --
- *
- *	Returns the hash table of commands.
- *
- * Results:
- *	Pointer to the hash table.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
 
-Tcl_HashTable *
-TclGetNamespaceCommandTable(
-    Tcl_Namespace *nsPtr)
-{
-    return &((Namespace *) nsPtr)->cmdTable;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetNamespaceChildTable --
- *
- *	Returns the hash table of child namespaces.
- *
- * Results:
- *	Pointer to the hash table.
- *
- * Side effects:
- *	Might allocate memory.
- *
- *----------------------------------------------------------------------
- */
+    /*
+     * 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.
+     */
 
-Tcl_HashTable *
-TclGetNamespaceChildTable(
-    Tcl_Namespace *nsPtr)
-{
-    Namespace *nPtr = (Namespace *) nsPtr;
-#ifndef BREAK_NAMESPACE_COMPAT
-    return &nPtr->childTable;
-#else
-    if (nPtr->childTablePtr == NULL) {
-	nPtr->childTablePtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+        oldTypePtr->freeIntRepProc(objPtr);
     }
-    return nPtr->childTablePtr;
-#endif
+
+    objPtr->internalRep.otherValuePtr = (VOID *) resNamePtr;
+    objPtr->typePtr = &tclNsNameType;
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclLogCommandInfo --
+ * UpdateStringOfNsName --
  *
- *	This function is invoked after an error occurs in an interpreter. It
- *	adds information to iPtr->errorInfo/errorStack fields to describe the
- *	command that was being executed when the error occurred. When pc and
- *	tosPtr are non-NULL, conveying a bytecode execution "inner context",
- *	and the offending instruction is suitable, that inner context is
- *	recorded in errorStack.
+ *	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.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Information about the command is added to errorInfo/errorStack and the
- *	line number stored internally in the interpreter is set.
+ *	The object's string is set to a copy of the fully qualified
+ *	namespace name.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TclLogCommandInfo(
-    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). */
-    const unsigned char *pc,    /* Current pc of bytecode execution context */
-    Tcl_Obj **tosPtr)           /* Current stack of bytecode execution
-                                 * context */
+static void
+UpdateStringOfNsName(objPtr)
+    register Tcl_Obj *objPtr; /* nsName object with string rep to update. */
 {
-    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;
-    }
-
-    if (command != NULL) {
-        /*
-         * Compute the line number where the error occurred.
-         */
-
-        iPtr->errorLine = 1;
-        for (p = script; p != command; p++) {
-            if (*p == '\n') {
-                iPtr->errorLine++;
-            }
-        }
+    ResolvedNsName *resNamePtr =
+        (ResolvedNsName *) objPtr->internalRep.otherValuePtr;
+    register Namespace *nsPtr;
+    char *name = "";
+    int length;
 
-        if (length < 0) {
-            length = strlen(command);
+    if ((resNamePtr != NULL)
+	    && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) {
+        nsPtr = resNamePtr->nsPtr;
+        if (nsPtr->flags & NS_DEAD) {
+            nsPtr = NULL;
         }
-        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);
-            }
+        if (nsPtr != NULL) {
+            name = nsPtr->fullName;
         }
     }
 
     /*
-     * TIP #348
+     * The following sets the string rep to an empty string on the heap
+     * if the internal rep is NULL.
      */
 
-    if (Tcl_IsShared(iPtr->errorStack)) {
-        Tcl_Obj *newObj;
-            
-        newObj = Tcl_DuplicateObj(iPtr->errorStack);
-        Tcl_DecrRefCount(iPtr->errorStack);
-        Tcl_IncrRefCount(newObj);
-        iPtr->errorStack = newObj;
-    }
-    if (iPtr->resetErrorStack) {
-	int len;
-
-        iPtr->resetErrorStack = 0;
-	Tcl_ListObjLength(interp, iPtr->errorStack, &len);
-
-        /*
-         * Reset while keeping the list intrep as much as possible.
-         */
-
-        Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
-        if (pc != NULL) {
-            Tcl_Obj *innerContext;
-
-            innerContext = TclGetInnerContext(interp, pc, tosPtr);
-            if (innerContext != NULL) {
-                Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-                        iPtr->innerLiteral);
-                Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext);
-            }
-        } else if (command != NULL) {
-            Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-                    iPtr->innerLiteral);
-            Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-                    Tcl_NewStringObj(command, length));
-        }
-    } 
-
-    if (!iPtr->framePtr->objc) {
-        /*
-         * Special frame, nothing to report.
-         */
-    } else if (iPtr->varFramePtr != iPtr->framePtr) {
-        /*
-         * uplevel case, [lappend errorstack UP $relativelevel]
-         */
-
-        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
-        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(
-		iPtr->framePtr->level - iPtr->varFramePtr->level));
-    } else if (iPtr->framePtr != iPtr->rootFramePtr) {
-        /*
-         * normal case, [lappend errorstack CALL [info level 0]]
-         */
-
-        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
-        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
-		iPtr->framePtr->objc, iPtr->framePtr->objv));
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclErrorStackResetIf --
- *
- *      The TIP 348 reset/no-bc part of TLCI, for specific use by
- *      TclCompileSyntaxError.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Reset errorstack if it needs be, and in that case remember the
- *	passed-in error message as inner context.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclErrorStackResetIf(
-    Tcl_Interp *interp,
-    const char *msg,
-    int length)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if (Tcl_IsShared(iPtr->errorStack)) {
-        Tcl_Obj *newObj;
-            
-        newObj = Tcl_DuplicateObj(iPtr->errorStack);
-        Tcl_DecrRefCount(iPtr->errorStack);
-        Tcl_IncrRefCount(newObj);
-        iPtr->errorStack = newObj;
+    length = strlen(name);
+    if (length == 0) {
+	objPtr->bytes = tclEmptyStringRep;
+    } else {
+	objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
+	memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
+	objPtr->bytes[length] = '\0';
     }
-    if (iPtr->resetErrorStack) {
-	int len;
-
-        iPtr->resetErrorStack = 0;
-	Tcl_ListObjLength(interp, iPtr->errorStack, &len);
-
-        /*
-         * Reset while keeping the list intrep as much as possible.
-         */
-
-        Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
-        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
-        Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
-                Tcl_NewStringObj(msg, length));
-    } 
+    objPtr->length = length;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_LogCommandInfo --
- *
- *	This function is invoked after an error occurs in an interpreter. It
- *	adds information to iPtr->errorInfo/errorStack fields to describe the
- *	command that was being executed when the error occurred.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Information about the command is added to errorInfo/errorStack 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). */
-{
-    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
-}
-
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
- * End:
- */
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index a6523fc..bf82f1c 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -1,34 +1,28 @@
-/*
+/* 
  * 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"
 
-/*
- * Module-scope struct of notifier hooks that are checked in the default
- * notifier functions (for overriding via Tcl_SetNotifier).
- */
-
-Tcl_NotifierProcs tclNotifierHooks = {
-    NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL
-};
+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 {
@@ -41,34 +35,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. */
@@ -82,20 +76,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 = NULL;
+static ThreadSpecificData *firstNotifierPtr;
 TCL_DECLARE_MUTEX(listLock)
 
 /*
  * Declarations for routines used only in this file.
  */
 
-static void		QueueEvent(ThreadSpecificData *tsdPtr,
-			    Tcl_Event *evPtr, Tcl_QueuePosition position);
+static void		QueueEvent _ANSI_ARGS_((ThreadSpecificData *tsdPtr,
+			    Tcl_Event* evPtr, Tcl_QueuePosition position));
 
 /*
  *----------------------------------------------------------------------
@@ -115,29 +109,18 @@ static void		QueueEvent(ThreadSpecificData *tsdPtr,
  */
 
 void
-TclInitNotifier(void)
+TclInitNotifier()
 {
-    ThreadSpecificData *tsdPtr;
-    Tcl_ThreadId threadId = Tcl_GetCurrentThread();
+    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     Tcl_MutexLock(&listLock);
-    for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
-	    tsdPtr = tsdPtr->nextPtr) {
-	/* Empty loop body. */
-    }
 
-    if (NULL == tsdPtr) {
-	/*
-	 * Notifier not yet initialized in this thread.
-	 */
+    tsdPtr->threadId = Tcl_GetCurrentThread();
+    tsdPtr->clientData = tclStubs.tcl_InitNotifier();
+    tsdPtr->initialized = 1;
+    tsdPtr->nextPtr = firstNotifierPtr;
+    firstNotifierPtr = tsdPtr;
 
-	tsdPtr = TCL_TSD_INIT(&dataKey);
-	tsdPtr->threadId = threadId;
-	tsdPtr->clientData = Tcl_InitNotifier();
-	tsdPtr->initialized = 1;
-	tsdPtr->nextPtr = firstNotifierPtr;
-	firstNotifierPtr = tsdPtr;
-    }
     Tcl_MutexUnlock(&listLock);
 }
 
@@ -146,42 +129,43 @@ TclInitNotifier(void)
  *
  * 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(void)
+TclFinalizeNotifier()
 {
     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 != NULL; ) {
+    for (evPtr = tsdPtr->firstEventPtr; evPtr != (Tcl_Event *) NULL; ) {
 	hold = evPtr;
 	evPtr = evPtr->nextPtr;
-	ckfree(hold);
+	ckfree((char *) hold);
     }
     tsdPtr->firstEventPtr = NULL;
     tsdPtr->lastEventPtr = NULL;
@@ -189,10 +173,12 @@ TclFinalizeNotifier(void)
 
     Tcl_MutexLock(&listLock);
 
-    Tcl_FinalizeNotifier(tsdPtr->clientData);
+    if (tclStubs.tcl_FinalizeNotifier) {
+	tclStubs.tcl_FinalizeNotifier(tsdPtr->clientData);
+    }
     Tcl_MutexFinalize(&(tsdPtr->queueMutex));
     for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
-	    prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
+	 prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
 	if (*prevPtrPtr == tsdPtr) {
 	    *prevPtrPtr = tsdPtr->nextPtr;
 	    break;
@@ -208,25 +194,35 @@ TclFinalizeNotifier(void)
  *
  * 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:
- *	Set the tclNotifierHooks global, which is checked in the default
- *	notifier functions.
+ *	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.)
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetNotifier(
-    Tcl_NotifierProcs *notifierProcPtr)
+Tcl_SetNotifier(notifierProcPtr)
+    Tcl_NotifierProcs *notifierProcPtr;
 {
-    tclNotifierHooks = *notifierProcPtr;
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    tclStubs.tcl_CreateFileHandler = notifierProcPtr->createFileHandlerProc;
+    tclStubs.tcl_DeleteFileHandler = notifierProcPtr->deleteFileHandlerProc;
+#endif
+    tclStubs.tcl_SetTimer = notifierProcPtr->setTimerProc;
+    tclStubs.tcl_WaitForEvent = notifierProcPtr->waitForEventProc;
+    tclStubs.tcl_InitNotifier = notifierProcPtr->initNotifierProc;
+    tclStubs.tcl_FinalizeNotifier = notifierProcPtr->finalizeNotifierProc;
+    tclStubs.tcl_AlertNotifier = notifierProcPtr->alertNotifierProc;
+    tclStubs.tcl_ServiceModeHook = notifierProcPtr->serviceModeHookProc;
 }
 
 /*
@@ -234,9 +230,10 @@ Tcl_SetNotifier(
  *
  * Tcl_CreateEventSource --
  *
- *	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.
+ *	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.
  *
  *
  * Results:
@@ -244,39 +241,37 @@ Tcl_SetNotifier(
  *
  * 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 functions is passed two arguments, e.g.
+ *	Each of these procedures 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(
-    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. */
+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. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    EventSource *sourcePtr = ckalloc(sizeof(EventSource));
+    EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
 
     sourcePtr->setupProc = setupProc;
     sourcePtr->checkProc = checkProc;
@@ -290,29 +285,28 @@ Tcl_CreateEventSource(
  *
  * Tcl_DeleteEventSource --
  *
- *	This function is invoked to delete the source of events given by proc
- *	and clientData.
+ *	This procedure is invoked to delete the source of events
+ *	given by proc and clientData.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The given event source is canceled, so its function will never again
- *	be called. If no such source exists, nothing happens.
+ *	The given event source is cancelled, so its procedure will
+ *	never again be called.  If no such source exists, nothing
+ *	happens.
  *
  *----------------------------------------------------------------------
  */
 
 void
-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. */
+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. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     EventSource *sourcePtr, *prevPtr;
@@ -330,7 +324,7 @@ Tcl_DeleteEventSource(
 	} else {
 	    prevPtr->nextPtr = sourcePtr->nextPtr;
 	}
-	ckfree(sourcePtr);
+	ckfree((char *) sourcePtr);
 	return;
     }
 }
@@ -340,7 +334,8 @@ Tcl_DeleteEventSource(
  *
  * 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.
@@ -352,17 +347,17 @@ Tcl_DeleteEventSource(
  */
 
 void
-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_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_QUEUE_MARK. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
     QueueEvent(tsdPtr, evPtr, position);
 }
 
@@ -383,14 +378,15 @@ Tcl_QueueEvent(
  */
 
 void
-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_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_QUEUE_MARK. */
 {
     ThreadSpecificData *tsdPtr;
@@ -401,7 +397,7 @@ Tcl_ThreadQueueEvent(
 
     Tcl_MutexLock(&listLock);
     for (tsdPtr = firstNotifierPtr; tsdPtr && tsdPtr->threadId != threadId;
-	    tsdPtr = tsdPtr->nextPtr) {
+	     tsdPtr = tsdPtr->nextPtr) {
 	/* Empty loop body. */
     }
 
@@ -412,7 +408,7 @@ Tcl_ThreadQueueEvent(
     if (tsdPtr) {
 	QueueEvent(tsdPtr, evPtr, position);
     } else {
-	ckfree(evPtr);
+	ckfree((char *) evPtr);
     }
     Tcl_MutexUnlock(&listLock);
 }
@@ -422,12 +418,12 @@ Tcl_ThreadQueueEvent(
  *
  * 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.
@@ -439,15 +435,16 @@ Tcl_ThreadQueueEvent(
  */
 
 static void
-QueueEvent(
-    ThreadSpecificData *tsdPtr,	/* Handle to thread local data that indicates
+QueueEvent(tsdPtr, evPtr, position)
+    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));
@@ -471,12 +468,12 @@ QueueEvent(
 	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) {
@@ -499,10 +496,10 @@ QueueEvent(
  *
  * Tcl_DeleteEvents --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -514,64 +511,36 @@ QueueEvent(
  */
 
 void
-Tcl_DeleteEvents(
-    Tcl_EventDeleteProc *proc,	/* The function to call. */
-    ClientData clientData)	/* The type-specific data. */
+Tcl_DeleteEvents(proc, clientData)
+    Tcl_EventDeleteProc *proc;		/* The procedure to call. */
+    ClientData clientData;    		/* type-specific data. */
 {
-    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;
+    Tcl_Event *evPtr, *prevPtr, *hold;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     Tcl_MutexLock(&(tsdPtr->queueMutex));
-
-    /*
-     * 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(hold);
-	} else {
-	    /*
-	     * Event is to be retained.
-	     */
-
-	    prevPtr = evPtr;
-	    evPtr = evPtr->nextPtr;
-	}
+    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;
+        }
     }
     Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 }
@@ -581,29 +550,30 @@ Tcl_DeleteEvents(
  *
  * 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 function actually found an event to
- *	process. If no processing occurred, then 0 is returned.
+ *	The return value is 1 if the procedure 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(
-    int flags)			/* Indicates what events should be processed.
+Tcl_ServiceEvent(flags)
+    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;
@@ -611,46 +581,46 @@ Tcl_ServiceEvent(
     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(NULL, 0);
+	(void) Tcl_AsyncInvoke((Tcl_Interp *) 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;
@@ -660,14 +630,14 @@ Tcl_ServiceEvent(
 	evPtr->proc = NULL;
 
 	/*
-	 * 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.
+	 * 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.
 	 */
 
 	Tcl_MutexUnlock(&(tsdPtr->queueMutex));
-	result = proc(evPtr, flags);
+	result = (*proc)(evPtr, flags);
 	Tcl_MutexLock(&(tsdPtr->queueMutex));
 
 	if (result) {
@@ -685,8 +655,8 @@ Tcl_ServiceEvent(
 		}
 	    } else {
 		for (prevPtr = tsdPtr->firstEventPtr;
-			prevPtr && prevPtr->nextPtr != evPtr;
-			prevPtr = prevPtr->nextPtr) {
+		     prevPtr && prevPtr->nextPtr != evPtr;
+		     prevPtr = prevPtr->nextPtr) {
 		    /* Empty loop body. */
 		}
 		if (prevPtr) {
@@ -702,14 +672,14 @@ Tcl_ServiceEvent(
 		}
 	    }
 	    if (evPtr) {
-		ckfree(evPtr);
+		ckfree((char *) evPtr);
 	    }
 	    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
 	    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;
@@ -736,7 +706,7 @@ Tcl_ServiceEvent(
  */
 
 int
-Tcl_GetServiceMode(void)
+Tcl_GetServiceMode()
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -754,14 +724,14 @@ Tcl_GetServiceMode(void)
  *	Returns the previous service mode.
  *
  * Side effects:
- *	Invokes the notifier service mode hook function.
+ *	Invokes the notifier service mode hook procedure.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_SetServiceMode(
-    int mode)			/* New service mode: TCL_SERVICE_ALL or
+Tcl_SetServiceMode(mode)
+    int mode;			/* New service mode: TCL_SERVICE_ALL or
 				 * TCL_SERVICE_NONE */
 {
     int oldMode;
@@ -769,7 +739,9 @@ Tcl_SetServiceMode(
 
     oldMode = tsdPtr->serviceMode;
     tsdPtr->serviceMode = mode;
-    Tcl_ServiceModeHook(mode);
+    if (tclStubs.tcl_ServiceModeHook) {
+	tclStubs.tcl_ServiceModeHook(mode);
+    }
     return oldMode;
 }
 
@@ -778,10 +750,10 @@ Tcl_SetServiceMode(
  *
  * Tcl_SetMaxBlockTime --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -793,10 +765,10 @@ Tcl_SetServiceMode(
  */
 
 void
-Tcl_SetMaxBlockTime(
-    const Tcl_Time *timePtr)		/* Specifies a maximum elapsed time for the
-				 * next blocking operation in the event
-				 * tsdPtr-> */
+Tcl_SetMaxBlockTime(timePtr)
+    Tcl_Time *timePtr;		/* Specifies a maximum elapsed time for
+				 * the next blocking operation in the
+				 * event tsdPtr-> */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
@@ -808,8 +780,8 @@ Tcl_SetMaxBlockTime(
     }
 
     /*
-     * 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) {
@@ -826,27 +798,27 @@ Tcl_SetMaxBlockTime(
  *
  * 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 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).
+ *	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).
  *
  * 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(
-    int flags)			/* Miscellaneous flag values: may be any
+Tcl_DoOneEvent(flags)
+    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
@@ -858,45 +830,47 @@ Tcl_DoOneEvent(
     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(NULL, 0);
+	(void) Tcl_AsyncInvoke((Tcl_Interp *) 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 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.
+     * 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.
      */
 
     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;
 	}
 
@@ -910,8 +884,8 @@ Tcl_DoOneEvent(
 	}
 
 	/*
-	 * 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) {
@@ -923,15 +897,15 @@ Tcl_DoOneEvent(
 	}
 
 	/*
-	 * 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);
+		(sourcePtr->setupProc)(sourcePtr->clientData, flags);
 	    }
 	}
 	tsdPtr->inTraversal = 0;
@@ -943,8 +917,8 @@ Tcl_DoOneEvent(
 	}
 
 	/*
-	 * 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);
@@ -958,9 +932,9 @@ Tcl_DoOneEvent(
 	 */
 
 	for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
-		sourcePtr = sourcePtr->nextPtr) {
+	     sourcePtr = sourcePtr->nextPtr) {
 	    if (sourcePtr->checkProc) {
-		sourcePtr->checkProc(sourcePtr->clientData, flags);
+		(sourcePtr->checkProc)(sourcePtr->clientData, flags);
 	    }
 	}
 
@@ -974,12 +948,12 @@ Tcl_DoOneEvent(
 	}
 
 	/*
-	 * 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;
@@ -991,21 +965,23 @@ Tcl_DoOneEvent(
 	}
 
 	/*
-	 * 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;
@@ -1017,11 +993,12 @@ Tcl_DoOneEvent(
  *
  * 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.
@@ -1033,7 +1010,7 @@ Tcl_DoOneEvent(
  */
 
 int
-Tcl_ServiceAll(void)
+Tcl_ServiceAll()
 {
     int result = 0;
     EventSource *sourcePtr;
@@ -1044,10 +1021,10 @@ Tcl_ServiceAll(void)
     }
 
     /*
-     * 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;
 
     /*
@@ -1055,28 +1032,28 @@ Tcl_ServiceAll(void)
      */
 
     if (Tcl_AsyncReady()) {
-	(void) Tcl_AsyncInvoke(NULL, 0);
+	(void) Tcl_AsyncInvoke((Tcl_Interp *) 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);
+	    (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);
+	    (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
 	}
     }
 
@@ -1102,8 +1079,8 @@ Tcl_ServiceAll(void)
  *
  * 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.
@@ -1115,31 +1092,26 @@ Tcl_ServiceAll(void)
  */
 
 void
-Tcl_ThreadAlert(
-    Tcl_ThreadId threadId)	/* Identifier for thread to use. */
+Tcl_ThreadAlert(threadId)
+    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);
     for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
 	if (tsdPtr->threadId == threadId) {
-	    Tcl_AlertNotifier(tsdPtr->clientData);
+	    if (tclStubs.tcl_AlertNotifier) {
+		tclStubs.tcl_AlertNotifier(tsdPtr->clientData);
+	    }
 	    break;
 	}
     }
     Tcl_MutexUnlock(&listLock);
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOO.c b/generic/tclOO.c
deleted file mode 100644
index d5cc6e1..0000000
--- a/generic/tclOO.c
+++ /dev/null
@@ -1,2963 +0,0 @@
-/*
- * tclOO.c --
- *
- *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
- *
- * Copyright (c) 2005-2011 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.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "tclInt.h"
-#include "tclOOInt.h"
-
-/*
- * Commands in oo::define.
- */
-
-static const struct {
-    const char *name;
-    Tcl_ObjCmdProc *objProc;
-    int flag;
-} defineCmds[] = {
-    {"constructor", TclOODefineConstructorObjCmd, 0},
-    {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
-    {"destructor", TclOODefineDestructorObjCmd, 0},
-    {"export", TclOODefineExportObjCmd, 0},
-    {"forward", TclOODefineForwardObjCmd, 0},
-    {"method", TclOODefineMethodObjCmd, 0},
-    {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
-    {"self", TclOODefineSelfObjCmd, 0},
-    {"unexport", TclOODefineUnexportObjCmd, 0},
-    {NULL, NULL, 0}
-}, objdefCmds[] = {
-    {"class", TclOODefineClassObjCmd, 1},
-    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
-    {"export", TclOODefineExportObjCmd, 1},
-    {"forward", TclOODefineForwardObjCmd, 1},
-    {"method", TclOODefineMethodObjCmd, 1},
-    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
-    {"unexport", TclOODefineUnexportObjCmd, 1},
-    {NULL, NULL, 0}
-};
-
-/*
- * What sort of size of things we like to allocate.
- */
-
-#define ALLOC_CHUNK 8
-
-/*
- * Function declarations for things defined in this file.
- */
-
-static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
-static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
-			    const char *nsNameStr);
-static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
-			    Method *mPtr, Tcl_Obj *namePtr,
-			    Method **newMPtrPtr);
-static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
-			    Method *mPtr, Tcl_Obj *namePtr);
-static void		DeletedDefineNamespace(ClientData clientData);
-static void		DeletedObjdefNamespace(ClientData clientData);
-static void		DeletedHelpersNamespace(ClientData clientData);
-static int		FinalizeAlloc(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		FinalizeNext(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		FinalizeObjectCall(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		InitFoundation(Tcl_Interp *interp);
-static void		KillFoundation(ClientData clientData,
-			    Tcl_Interp *interp);
-static void		MyDeleted(ClientData clientData);
-static void		ObjectNamespaceDeleted(ClientData clientData);
-static void		ObjectRenamedTrace(ClientData clientData,
-			    Tcl_Interp *interp, const char *oldName,
-			    const char *newName, int flags);
-static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
-static void		SquelchedNsFirst(ClientData clientData);
-
-static int		PublicObjectCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-static int		PublicNRObjectCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-static int		PrivateObjectCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-static int		PrivateNRObjectCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-
-/*
- * Methods in the oo::object and oo::class classes. First, we define a helper
- * macro that makes building the method type declaration structure a lot
- * easier. No point in making life harder than it has to be!
- *
- * Note that the core methods don't need clone or free proc callbacks.
- */
-
-#define DCM(name,visibility,proc) \
-    {name,visibility,\
-	{TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}}
-
-static const DeclaredClassMethod objMethods[] = {
-    DCM("destroy", 1,	TclOO_Object_Destroy),
-    DCM("eval", 0,	TclOO_Object_Eval),
-    DCM("unknown", 0,	TclOO_Object_Unknown),
-    DCM("variable", 0,	TclOO_Object_LinkVar),
-    DCM("varname", 0,	TclOO_Object_VarName),
-    {NULL, 0, {0, NULL, NULL, NULL, NULL}}
-}, clsMethods[] = {
-    DCM("create", 1,	TclOO_Class_Create),
-    DCM("new", 1,	TclOO_Class_New),
-    DCM("createWithNamespace", 0, TclOO_Class_CreateNs),
-    {NULL, 0, {0, NULL, NULL, NULL, NULL}}
-};
-
-/*
- * Scripted parts of TclOO. First, the master script (cannot be outside this
- * file).
- */
-
-static const char *initScript =
-"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
-"namespace eval ::oo { variable version " TCLOO_VERSION " };"
-"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
-/* "tcl_findLibrary tcloo $oo::version $oo::version" */
-/* " tcloo.tcl OO_LIBRARY oo::library;"; */
-
-/*
- * The body of the constructor for oo::class.
- */
-
-static const char *classConstructorBody =
-"set script [list ::oo::define [self] $definitionScript];"
-"lassign [::oo::UpCatch $script] msg opts;"
-"if {[dict get $opts -code] == 1} {"
-"    dict set opts -errorline 0xDeadBeef"
-"};"
-"return -options $opts $msg;";
-
-/*
- * The scripted part of the definitions of slots.
- */
-
-static const char *slotScript =
-"::oo::define ::oo::Slot {\n"
-"    method Get {} {error unimplemented}\n"
-"    method Set list {error unimplemented}\n"
-"    method -set args {\n"
-"        uplevel 1 [list [namespace which my] Set $args]\n"
-"    }\n"
-"    method -append args {\n"
-"        uplevel 1 [list [namespace which my] Set [list"
-"                {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
-"    }\n"
-"    method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
-"    forward --default-operation my -append\n"
-"    method unknown {args} {\n"
-"        set def --default-operation\n"
-"        if {[llength $args] == 0} {\n"
-"            return [uplevel 1 [list [namespace which my] $def]]\n"
-"        } elseif {![string match -* [lindex $args 0]]} {\n"
-"            return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
-"        }\n"
-"        next {*}$args\n"
-"    }\n"
-"    export -set -append -clear\n"
-"    unexport unknown destroy\n"
-"}\n"
-"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
-"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
-"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";
-
-/*
- * The body of the <cloned> method of oo::object.
- */
-
-static const char *clonedBody =
-"foreach p [info procs [info object namespace $originObject]::*] {"
-"    set args [info args $p];"
-"    set idx -1;"
-"    foreach a $args {"
-"        lset args [incr idx] "
-"            [if {[info default $p $a d]} {list $a $d} {list $a}]"
-"    };"
-"    set b [info body $p];"
-"    set p [namespace tail $p];"
-"    proc $p $args $b;"
-"};"
-"foreach v [info vars [info object namespace $originObject]::*] {"
-"    upvar 0 $v vOrigin;"
-"    namespace upvar [namespace current] [namespace tail $v] vNew;"
-"    if {[info exists vOrigin]} {"
-"        if {[array exists vOrigin]} {"
-"            array set vNew [array get vOrigin];"
-"        } else {"
-"            set vNew $vOrigin;"
-"        }"
-"    }"
-"}";
-
-/*
- * The actual definition of the variable holding the TclOO stub table.
- */
-
-MODULE_SCOPE const TclOOStubs tclOOStubs;
-
-/*
- * Convenience macro for getting the foundation from an interpreter.
- */
-
-#define GetFoundation(interp) \
-	((Foundation *)((Interp *)(interp))->objectFoundation)
-
-/*
- * Macros to make inspecting into the guts of an object cleaner.
- *
- * The ocPtr parameter (only in these macros) is assumed to work fine with
- * either an oPtr or a classPtr. Note that the roots oo::object and oo::class
- * have _both_ their object and class flags tagged with ROOT_OBJECT and
- * ROOT_CLASS respectively.
- */
-
-#define Deleted(oPtr)		(((Object *)(oPtr))->command == NULL)
-#define IsRootObject(ocPtr)	((ocPtr)->flags & ROOT_OBJECT)
-#define IsRootClass(ocPtr)	((ocPtr)->flags & ROOT_CLASS)
-#define IsRoot(ocPtr)		((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOInit --
- *
- *	Called to initialise the OO system within an interpreter.
- *
- * Result:
- *	TCL_OK if the setup succeeded. Currently assumed to always work.
- *
- * Side effects:
- *	Creates namespaces, commands, several classes and a number of
- *	callbacks. Upon return, the OO system is ready for use.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOInit(
-    Tcl_Interp *interp)		/* The interpreter to install into. */
-{
-    /*
-     * Build the core of the OO system.
-     */
-
-    if (InitFoundation(interp) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Run our initialization script and, if that works, declare the package
-     * to be fully provided.
-     */
-
-    if (Tcl_Eval(interp, initScript) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_VERSION,
-	    (ClientData) &tclOOStubs);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOGetFoundation --
- *
- *	Get a reference to the OO core class system.
- *
- * ----------------------------------------------------------------------
- */
-
-Foundation *
-TclOOGetFoundation(
-    Tcl_Interp *interp)
-{
-    return GetFoundation(interp);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InitFoundation --
- *
- *	Set up the core of the OO core class system. This is a structure
- *	holding references to the magical bits that need to be known about in
- *	other places, plus the oo::object and oo::class classes.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InitFoundation(
-    Tcl_Interp *interp)
-{
-    static Tcl_ThreadDataKey tsdKey;
-    ThreadLocalData *tsdPtr =
-	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
-    Foundation *fPtr = ckalloc(sizeof(Foundation));
-    Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
-    Tcl_DString buffer;
-    int i;
-
-    /*
-     * Initialize the structure that holds the OO system core. This is
-     * attached to the interpreter via an assocData entry; not very efficient,
-     * but the best we can do without hacking the core more.
-     */
-
-    memset(fPtr, 0, sizeof(Foundation));
-    ((Interp *) interp)->objectFoundation = fPtr;
-    fPtr->interp = interp;
-    fPtr->ooNs = Tcl_CreateNamespace(interp, "::oo", fPtr, NULL);
-    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
-    fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
-	    DeletedDefineNamespace);
-    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
-	    DeletedObjdefNamespace);
-    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
-	    DeletedHelpersNamespace);
-    fPtr->epoch = 0;
-    fPtr->tsdPtr = tsdPtr;
-    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
-    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
-    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
-    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
-    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
-    Tcl_IncrRefCount(fPtr->constructorName);
-    Tcl_IncrRefCount(fPtr->destructorName);
-    Tcl_IncrRefCount(fPtr->clonedName);
-    Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd,
-	    TclOONRUpcatch, NULL, NULL);
-    Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
-	    TclOOUnknownDefinition, NULL, NULL);
-    TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
-    Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
-    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);
-
-    /*
-     * Create the subcommands in the oo::define and oo::objdefine spaces.
-     */
-
-    Tcl_DStringInit(&buffer);
-    for (i=0 ; defineCmds[i].name ; i++) {
-	Tcl_DStringAppend(&buffer, "::oo::define::", 14);
-	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
-	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
-		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
-	Tcl_DStringFree(&buffer);
-    }
-    for (i=0 ; objdefCmds[i].name ; i++) {
-	Tcl_DStringAppend(&buffer, "::oo::objdefine::", 17);
-	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
-	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
-		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
-	Tcl_DStringFree(&buffer);
-    }
-
-    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);
-
-    /*
-     * Create the objects at the core of the object system. These need to be
-     * spliced manually.
-     */
-
-    fPtr->objectCls = AllocClass(interp,
-	    AllocObject(interp, "::oo::object", NULL));
-    fPtr->classCls = AllocClass(interp,
-	    AllocObject(interp, "::oo::class", NULL));
-    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
-    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
-    fPtr->objectCls->flags |= ROOT_OBJECT;
-    fPtr->objectCls->superclasses.num = 0;
-    ckfree(fPtr->objectCls->superclasses.list);
-    fPtr->objectCls->superclasses.list = NULL;
-    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
-    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
-    fPtr->classCls->flags |= ROOT_CLASS;
-    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
-    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
-    AddRef(fPtr->objectCls->thisPtr);
-    AddRef(fPtr->objectCls);
-
-    /*
-     * Basic method declarations for the core classes.
-     */
-
-    for (i=0 ; objMethods[i].name ; i++) {
-	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
-    }
-    for (i=0 ; clsMethods[i].name ; i++) {
-	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
-    }
-
-    /*
-     * Create the default <cloned> method implementation, used when 'oo::copy'
-     * is called to finish the copying of one object to another.
-     */
-
-    TclNewLiteralStringObj(argsPtr, "originObject");
-    Tcl_IncrRefCount(argsPtr);
-    bodyPtr = Tcl_NewStringObj(clonedBody, -1);
-    TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
-	    bodyPtr, NULL);
-    Tcl_DecrRefCount(argsPtr);
-
-    /*
-     * Finish setting up the class of classes by marking the 'new' method as
-     * private; classes, unlike general objects, must have explicit names. We
-     * also need to create the constructor for classes.
-     *
-     * The 0xDeadBeef is a special signal to the errorInfo logger that is used
-     * by constructors that stops it from generating extra error information
-     * that is confusing.
-     */
-
-    TclNewLiteralStringObj(namePtr, "new");
-    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
-	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);
-
-    TclNewLiteralStringObj(argsPtr, "{definitionScript {}}");
-    Tcl_IncrRefCount(argsPtr);
-    bodyPtr = Tcl_NewStringObj(classConstructorBody, -1);
-    fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
-	    fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
-    Tcl_DecrRefCount(argsPtr);
-
-    /*
-     * Create non-object commands and plug ourselves into the Tcl [info]
-     * ensemble.
-     */
-
-    Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "::oo::Helpers::self", TclOOSelfObjCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL);
-    TclOOInitInfo(interp);
-
-    /*
-     * Now make the class of slots.
-     */
-
-    if (TclOODefineSlots(fPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    return Tcl_Eval(interp, slotScript);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
- *
- *	Simple helpers used to clear fields of the foundation when they no
- *	longer hold useful information.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-DeletedDefineNamespace(
-    ClientData clientData)
-{
-    Foundation *fPtr = clientData;
-
-    fPtr->defineNs = NULL;
-}
-
-static void
-DeletedObjdefNamespace(
-    ClientData clientData)
-{
-    Foundation *fPtr = clientData;
-
-    fPtr->objdefNs = NULL;
-}
-
-static void
-DeletedHelpersNamespace(
-    ClientData clientData)
-{
-    Foundation *fPtr = clientData;
-
-    fPtr->helpersNs = NULL;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * KillFoundation --
- *
- *	Delete those parts of the OO core that are not deleted automatically
- *	when the objects and classes themselves are destroyed.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-KillFoundation(
-    ClientData clientData,	/* Pointer to the OO system foundation
-				 * structure. */
-    Tcl_Interp *interp)		/* The interpreter containing the OO system
-				 * foundation. */
-{
-    Foundation *fPtr = GetFoundation(interp);
-
-    DelRef(fPtr->objectCls->thisPtr);
-    DelRef(fPtr->objectCls);
-    Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
-    Tcl_DecrRefCount(fPtr->constructorName);
-    Tcl_DecrRefCount(fPtr->destructorName);
-    Tcl_DecrRefCount(fPtr->clonedName);
-    ckfree(fPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * AllocObject --
- *
- *	Allocate an object of basic type. Does not splice the object into its
- *	class's instance list.
- *
- * ----------------------------------------------------------------------
- */
-
-static Object *
-AllocObject(
-    Tcl_Interp *interp,		/* Interpreter within which to create the
-				 * object. */
-    const char *nameStr,	/* The name of the object to create, or NULL
-				 * if the OO system should pick the object
-				 * name itself (equal to the namespace
-				 * name). */
-    const char *nsNameStr)	/* The name of the namespace to create, or
-				 * NULL if the OO system should pick a unique
-				 * name itself. If this is non-NULL but names
-				 * a namespace that already exists, the effect
-				 * will be the same as if this was NULL. */
-{
-    Foundation *fPtr = GetFoundation(interp);
-    Object *oPtr;
-    Command *cmdPtr;
-    CommandTrace *tracePtr;
-    int creationEpoch, ignored;
-
-    oPtr = ckalloc(sizeof(Object));
-    memset(oPtr, 0, sizeof(Object));
-
-    /*
-     * Every object has a namespace; make one. Note that this also normally
-     * computes the creation epoch value for the object, a sequence number
-     * that is unique to the object (and which allows us to manage method
-     * caching without comparing pointers).
-     *
-     * When creating a namespace, we first check to see if the caller
-     * specified the name for the namespace. If not, we generate namespace
-     * names using the epoch until such time as a new namespace is actually
-     * created.
-     */
-
-    if (nsNameStr != NULL) {
-	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr,
-		ObjectNamespaceDeleted);
-	if (oPtr->namespacePtr != NULL) {
-	    creationEpoch = ++fPtr->tsdPtr->nsCount;
-	    goto configNamespace;
-	}
-	Tcl_ResetResult(interp);
-    }
-
-    while (1) {
-	char objName[10 + TCL_INTEGER_SPACE];
-
-	sprintf(objName, "::oo::Obj%d", ++fPtr->tsdPtr->nsCount);
-	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr,
-		ObjectNamespaceDeleted);
-	if (oPtr->namespacePtr != NULL) {
-	    creationEpoch = fPtr->tsdPtr->nsCount;
-	    break;
-	}
-
-	/*
-	 * Could not make that namespace, so we make another. But first we
-	 * have to get rid of the error message from Tcl_CreateNamespace,
-	 * since that's something that should not be exposed to the user.
-	 */
-
-	Tcl_ResetResult(interp);
-    }
-
-    /*
-     * Make the namespace know about the helper commands. This grants access
-     * to the [self] and [next] commands.
-     */
-
-  configNamespace:
-    if (fPtr->helpersNs != NULL) {
-	TclSetNsPath((Namespace *) oPtr->namespacePtr, 1, &fPtr->helpersNs);
-    }
-    TclOOSetupVariableResolver(oPtr->namespacePtr);
-
-    /*
-     * Suppress use of compiled versions of the commands in this object's
-     * namespace and its children; causes wrong behaviour without expensive
-     * recompilation. [Bug 2037727]
-     */
-
-    ((Namespace *) oPtr->namespacePtr)->flags |= NS_SUPPRESS_COMPILATION;
-
-    /*
-     * Set up a callback to get notification of the deletion of a namespace
-     * when enough of the namespace still remains to execute commands and
-     * access variables in it. [Bug 2950259]
-     */
-
-    ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = SquelchedNsFirst;
-
-    /*
-     * Fill in the rest of the non-zero/NULL parts of the structure.
-     */
-
-    oPtr->fPtr = fPtr;
-    oPtr->selfCls = fPtr->objectCls;
-    oPtr->creationEpoch = creationEpoch;
-    oPtr->refCount = 1;
-    oPtr->flags = USE_CLASS_CACHE;
-
-    /*
-     * Finally, create the object commands and initialize the trace on the
-     * public command (so that the object structures are deleted when the
-     * command is deleted).
-     */
-
-    if (!nameStr) {
-	oPtr->command = Tcl_CreateObjCommand(interp,
-		oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL);
-    } else if (nameStr[0] == ':' && nameStr[1] == ':') {
-	oPtr->command = Tcl_CreateObjCommand(interp, nameStr,
-		PublicObjectCmd, oPtr, NULL);
-    } else {
-	Tcl_DString buffer;
-
-	Tcl_DStringInit(&buffer);
-	Tcl_DStringAppend(&buffer,
-		Tcl_GetCurrentNamespace(interp)->fullName, -1);
-	Tcl_DStringAppend(&buffer, "::", 2);
-	Tcl_DStringAppend(&buffer, nameStr, -1);
-	oPtr->command = Tcl_CreateObjCommand(interp,
-		Tcl_DStringValue(&buffer), PublicObjectCmd, oPtr, NULL);
-	Tcl_DStringFree(&buffer);
-    }
-
-    /*
-     * Add the NRE command and trace directly. While this breaks a number of
-     * abstractions, it is faster and we're inside Tcl here so we're allowed.
-     */
-
-    cmdPtr = (Command *) oPtr->command;
-    cmdPtr->nreProc = PublicNRObjectCmd;
-    cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace));
-    tracePtr->traceProc = ObjectRenamedTrace;
-    tracePtr->clientData = oPtr;
-    tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
-    tracePtr->nextPtr = NULL;
-    tracePtr->refCount = 1;
-
-    /*
-     * Access the namespace command table directly when creating "my" to avoid
-     * a bottleneck in string manipulation. Another abstraction-buster.
-     */
-
-    cmdPtr = ckalloc(sizeof(Command));
-    memset(cmdPtr, 0, sizeof(Command));
-    cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr;
-    cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my",
-	    &ignored);
-    cmdPtr->refCount = 1;
-    cmdPtr->objProc = PrivateObjectCmd;
-    cmdPtr->deleteProc = MyDeleted;
-    cmdPtr->objClientData = cmdPtr->deleteData = oPtr;
-    cmdPtr->proc = TclInvokeObjectCommand;
-    cmdPtr->clientData = cmdPtr;
-    cmdPtr->nreProc = PrivateNRObjectCmd;
-    Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr);
-    oPtr->myCommand = (Tcl_Command) cmdPtr;
-
-    return oPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * MyDeleted --
- *
- *	This callback is triggered when the object's [my] command is deleted
- *	by any mechanism. It just marks the object as not having a [my]
- *	command, and so prevents cleanup of that when the object itself is
- *	deleted.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-MyDeleted(
-    ClientData clientData)	/* Reference to the object whose [my] has been
-				 * squelched. */
-{
-    register Object *oPtr = clientData;
-
-    oPtr->myCommand = NULL;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * SquelchedNsFirst --
- *
- *	This callback is triggered when the object's namespace is deleted by
- *	any mechanism. It deletes the object's public command if it has not
- *	already been deleted, so ensuring that destructors get run at an
- *	appropriate time. [Bug 2950259]
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-SquelchedNsFirst(
-    ClientData clientData)
-{
-    Object *oPtr = clientData;
-
-    if (oPtr->command) {
-	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ObjectRenamedTrace --
- *
- *	This callback is triggered when the object is deleted by any
- *	mechanism. It runs the destructors and arranges for the actual cleanup
- *	of the object's namespace, which in turn triggers cleansing of the
- *	object data structures.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-ObjectRenamedTrace(
-    ClientData clientData,	/* The object being deleted. */
-    Tcl_Interp *interp,		/* The interpreter containing the object. */
-    const char *oldName,	/* What the object was (last) called. */
-    const char *newName,	/* Always NULL. */
-    int flags)			/* Why was the object deleted? */
-{
-    Object *oPtr = clientData;
-    Foundation *fPtr = oPtr->fPtr;
-
-    /*
-     * If this is a rename and not a delete of the object, we just flush the
-     * cache of the object name.
-     */
-
-    if (flags & TCL_TRACE_RENAME) {
-	if (oPtr->cachedNameObj) {
-	    Tcl_DecrRefCount(oPtr->cachedNameObj);
-	    oPtr->cachedNameObj = NULL;
-	}
-	return;
-    }
-
-    /*
-     * Oh dear, the object really is being deleted. Handle this by running the
-     * destructors and deleting the object's namespace, which in turn causes
-     * the real object structures to be deleted.
-     *
-     * Note that it is possible for the namespace to be deleted before the
-     * command. Because of that case, we must take care here to mark the
-     * command as being deleted so that if we return here we don't run into
-     * reentrancy problems.
-     *
-     * We also do not run destructors on the core class objects when the
-     * interpreter is being deleted; their incestuous nature causes problems
-     * in that case when the destructor is partially deleted before the uses
-     * of it have gone. [Bug 2949397]
-     */
-
-    AddRef(oPtr);
-    AddRef(fPtr->classCls);
-    AddRef(fPtr->objectCls);
-    AddRef(fPtr->classCls->thisPtr);
-    AddRef(fPtr->objectCls->thisPtr);
-    oPtr->command = NULL;
-
-    if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) {
-	CallContext *contextPtr =
-		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
-	int result;
-	Tcl_InterpState state;
-
-	oPtr->flags |= DESTRUCTOR_CALLED;
-	if (contextPtr != NULL) {
-	    contextPtr->callPtr->flags |= DESTRUCTOR;
-	    contextPtr->skip = 0;
-	    state = Tcl_SaveInterpState(interp, TCL_OK);
-	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
-		    contextPtr, 0, NULL);
-	    if (result != TCL_OK) {
-		Tcl_BackgroundError(interp);
-	    }
-	    Tcl_RestoreInterpState(interp, state);
-	    TclOODeleteContext(contextPtr);
-	}
-    }
-
-    /*
-     * OK, the destructor's been run. Time to splat the class data (if any)
-     * and nuke the namespace (which triggers the final crushing of the object
-     * structure itself).
-     *
-     * The class of objects needs some special care; if it is deleted (and
-     * we're not killing the whole interpreter) we force the delete of the
-     * class of classes now as well. Due to the incestuous nature of those two
-     * classes, if one goes the other must too and yet the tangle can
-     * sometimes not go away automatically; we force it here. [Bug 2962664]
-     */
-
-    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
-	    && !Deleted(fPtr->classCls->thisPtr)) {
-	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
-    }
-
-    if (oPtr->classPtr != NULL) {
-	AddRef(oPtr->classPtr);
-	ReleaseClassContents(interp, oPtr);
-    }
-
-    /*
-     * The namespace is only deleted if it hasn't already been deleted. [Bug
-     * 2950259]
-     */
-
-    if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
-	Tcl_DeleteNamespace(oPtr->namespacePtr);
-    }
-    if (oPtr->classPtr) {
-	DelRef(oPtr->classPtr);
-    }
-    DelRef(fPtr->classCls->thisPtr);
-    DelRef(fPtr->objectCls->thisPtr);
-    DelRef(fPtr->classCls);
-    DelRef(fPtr->objectCls);
-    DelRef(oPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ReleaseClassContents --
- *
- *	Tear down the special class data structure, including deleting all
- *	dependent classes and objects.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-ReleaseClassContents(
-    Tcl_Interp *interp,		/* The interpreter containing the class. */
-    Object *oPtr)		/* The object representing the class. */
-{
-    FOREACH_HASH_DECLS;
-    int i;
-    Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr;
-    Object *instancePtr;
-    Foundation *fPtr = oPtr->fPtr;
-
-    /*
-     * Sanity check!
-     */
-
-    if (!Deleted(oPtr)) {
-	if (IsRootClass(oPtr)) {
-	    Tcl_Panic("deleting class structure for non-deleted %s",
-		    "::oo::class");
-	} else if (IsRootObject(oPtr)) {
-	    Tcl_Panic("deleting class structure for non-deleted %s",
-		    "::oo::object");
-	} else {
-	    Tcl_Panic("deleting class structure for non-deleted %s",
-		    "general object");
-	}
-    }
-
-    /*
-     * Lock a number of dependent objects until we've stopped putting our
-     * fingers in them.
-     */
-
-    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
-	if (mixinSubclassPtr != NULL) {
-	    AddRef(mixinSubclassPtr);
-	    AddRef(mixinSubclassPtr->thisPtr);
-	}
-    }
-    FOREACH(subclassPtr, clsPtr->subclasses) {
-	if (subclassPtr != NULL && !IsRoot(subclassPtr)) {
-	    AddRef(subclassPtr);
-	    AddRef(subclassPtr->thisPtr);
-	}
-    }
-    if (!IsRootClass(oPtr)) {
-	FOREACH(instancePtr, clsPtr->instances) {
-	    if (instancePtr != NULL && !IsRoot(instancePtr)) {
-		AddRef(instancePtr);
-	    }
-	}
-    }
-
-    /*
-     * Squelch classes that this class has been mixed into.
-     */
-
-    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
-	if (mixinSubclassPtr == NULL) {
-	    continue;
-	}
-	if (!Deleted(mixinSubclassPtr->thisPtr)) {
-	    Tcl_DeleteCommandFromToken(interp,
-		    mixinSubclassPtr->thisPtr->command);
-	}
-	DelRef(mixinSubclassPtr->thisPtr);
-	DelRef(mixinSubclassPtr);
-    }
-    if (clsPtr->mixinSubs.list != NULL) {
-	ckfree(clsPtr->mixinSubs.list);
-	clsPtr->mixinSubs.list = NULL;
-	clsPtr->mixinSubs.num = 0;
-    }
-
-    /*
-     * Squelch subclasses of this class.
-     */
-
-    FOREACH(subclassPtr, clsPtr->subclasses) {
-	if (subclassPtr == NULL || IsRoot(subclassPtr)) {
-	    continue;
-	}
-	if (!Deleted(subclassPtr->thisPtr)) {
-	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
-	}
-	DelRef(subclassPtr->thisPtr);
-	DelRef(subclassPtr);
-    }
-    if (clsPtr->subclasses.list != NULL) {
-	ckfree(clsPtr->subclasses.list);
-	clsPtr->subclasses.list = NULL;
-	clsPtr->subclasses.num = 0;
-    }
-
-    /*
-     * Squelch instances of this class (includes objects we're mixed into).
-     */
-
-    if (!IsRootClass(oPtr)) {
-	FOREACH(instancePtr, clsPtr->instances) {
-	    if (instancePtr == NULL || IsRoot(instancePtr)) {
-		continue;
-	    }
-	    if (!Deleted(instancePtr)) {
-		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
-	    }
-	    DelRef(instancePtr);
-	}
-    }
-    if (clsPtr->instances.list != NULL) {
-	ckfree(clsPtr->instances.list);
-	clsPtr->instances.list = NULL;
-	clsPtr->instances.num = 0;
-    }
-
-    /*
-     * Special: We delete these after everything else.
-     */
-
-    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
-	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
-    }
-
-    /*
-     * Squelch method implementation chain caches.
-     */
-
-    if (clsPtr->constructorChainPtr) {
-	TclOODeleteChain(clsPtr->constructorChainPtr);
-	clsPtr->constructorChainPtr = NULL;
-    }
-    if (clsPtr->destructorChainPtr) {
-	TclOODeleteChain(clsPtr->destructorChainPtr);
-	clsPtr->destructorChainPtr = NULL;
-    }
-    if (clsPtr->classChainCache) {
-	CallChain *callPtr;
-
-	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
-	    TclOODeleteChain(callPtr);
-	}
-	Tcl_DeleteHashTable(clsPtr->classChainCache);
-	ckfree(clsPtr->classChainCache);
-	clsPtr->classChainCache = NULL;
-    }
-
-    /*
-     * Squelch our filter list.
-     */
-
-    if (clsPtr->filters.num) {
-	Tcl_Obj *filterObj;
-
-	FOREACH(filterObj, clsPtr->filters) {
-	    Tcl_DecrRefCount(filterObj);
-	}
-	ckfree(clsPtr->filters.list);
-	clsPtr->filters.num = 0;
-    }
-
-    /*
-     * Squelch our metadata.
-     */
-
-    if (clsPtr->metadataPtr != NULL) {
-	Tcl_ObjectMetadataType *metadataTypePtr;
-	ClientData value;
-
-	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
-	    metadataTypePtr->deleteProc(value);
-	}
-	Tcl_DeleteHashTable(clsPtr->metadataPtr);
-	ckfree(clsPtr->metadataPtr);
-	clsPtr->metadataPtr = NULL;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ObjectNamespaceDeleted --
- *
- *	Callback when the object's namespace is deleted. Used to clean up the
- *	data structures associated with the object. The complicated bit is
- *	that this can sometimes happen before the object's command is deleted
- *	(interpreter teardown is complex!)
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-ObjectNamespaceDeleted(
-    ClientData clientData)	/* Pointer to the class whose namespace is
-				 * being deleted. */
-{
-    Object *oPtr = clientData;
-    FOREACH_HASH_DECLS;
-    Class *clsPtr = oPtr->classPtr, *mixinPtr;
-    Method *mPtr;
-    Tcl_Obj *filterObj, *variableObj;
-    int i;
-
-    /*
-     * Instruct everyone to no longer use any allocated fields of the object.
-     * Also delete the commands that refer to the object at this point (if
-     * they still exist) because otherwise their references to the object
-     * point into freed memory, allowing crashes.
-     */
-
-    if (oPtr->command) {
-	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
-    }
-    if (oPtr->myCommand) {
-	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
-    }
-
-    /*
-     * Splice the object out of its context. After this, we must *not* call
-     * methods on the object.
-     */
-
-    if (!IsRootObject(oPtr)) {
-	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
-    }
-
-    FOREACH(mixinPtr, oPtr->mixins) {
-	TclOORemoveFromInstances(oPtr, mixinPtr);
-    }
-    if (i) {
-	ckfree(oPtr->mixins.list);
-    }
-
-    FOREACH(filterObj, oPtr->filters) {
-	Tcl_DecrRefCount(filterObj);
-    }
-    if (i) {
-	ckfree(oPtr->filters.list);
-    }
-
-    if (oPtr->methodsPtr) {
-	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
-	    TclOODelMethodRef(mPtr);
-	}
-	Tcl_DeleteHashTable(oPtr->methodsPtr);
-	ckfree(oPtr->methodsPtr);
-    }
-
-    FOREACH(variableObj, oPtr->variables) {
-	Tcl_DecrRefCount(variableObj);
-    }
-    if (i) {
-	ckfree(oPtr->variables.list);
-    }
-
-    if (oPtr->chainCache) {
-	TclOODeleteChainCache(oPtr->chainCache);
-    }
-
-    if (oPtr->cachedNameObj) {
-	Tcl_DecrRefCount(oPtr->cachedNameObj);
-	oPtr->cachedNameObj = NULL;
-    }
-
-    if (oPtr->metadataPtr != NULL) {
-	Tcl_ObjectMetadataType *metadataTypePtr;
-	ClientData value;
-
-	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
-	    metadataTypePtr->deleteProc(value);
-	}
-	Tcl_DeleteHashTable(oPtr->metadataPtr);
-	ckfree(oPtr->metadataPtr);
-	oPtr->metadataPtr = NULL;
-    }
-
-    if (clsPtr != NULL) {
-	Class *superPtr;
-	Tcl_ObjectMetadataType *metadataTypePtr;
-	ClientData value;
-
-	if (clsPtr->metadataPtr != NULL) {
-	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
-		metadataTypePtr->deleteProc(value);
-	    }
-	    Tcl_DeleteHashTable(clsPtr->metadataPtr);
-	    ckfree(clsPtr->metadataPtr);
-	    clsPtr->metadataPtr = NULL;
-	}
-
-	FOREACH(filterObj, clsPtr->filters) {
-	    Tcl_DecrRefCount(filterObj);
-	}
-	if (i) {
-	    ckfree(clsPtr->filters.list);
-	    clsPtr->filters.num = 0;
-	}
-	FOREACH(mixinPtr, clsPtr->mixins) {
-	    if (!Deleted(mixinPtr->thisPtr)) {
-		TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
-	    }
-	}
-	if (i) {
-	    ckfree(clsPtr->mixins.list);
-	    clsPtr->mixins.num = 0;
-	}
-	FOREACH(superPtr, clsPtr->superclasses) {
-	    if (!Deleted(superPtr->thisPtr)) {
-		TclOORemoveFromSubclasses(clsPtr, superPtr);
-	    }
-	}
-	if (i) {
-	    ckfree(clsPtr->superclasses.list);
-	    clsPtr->superclasses.num = 0;
-	}
-	if (clsPtr->subclasses.list) {
-	    ckfree(clsPtr->subclasses.list);
-	    clsPtr->subclasses.num = 0;
-	}
-	if (clsPtr->instances.list) {
-	    ckfree(clsPtr->instances.list);
-	    clsPtr->instances.num = 0;
-	}
-	if (clsPtr->mixinSubs.list) {
-	    ckfree(clsPtr->mixinSubs.list);
-	    clsPtr->mixinSubs.num = 0;
-	}
-
-	FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
-	    TclOODelMethodRef(mPtr);
-	}
-	Tcl_DeleteHashTable(&clsPtr->classMethods);
-	TclOODelMethodRef(clsPtr->constructorPtr);
-	TclOODelMethodRef(clsPtr->destructorPtr);
-
-	FOREACH(variableObj, clsPtr->variables) {
-	    Tcl_DecrRefCount(variableObj);
-	}
-	if (i) {
-	    ckfree(clsPtr->variables.list);
-	}
-
-	DelRef(clsPtr);
-    }
-
-    /*
-     * Delete the object structure itself.
-     */
-
-    DelRef(oPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOORemoveFromInstances --
- *
- *	Utility function to remove an object from the list of instances within
- *	a class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOORemoveFromInstances(
-    Object *oPtr,		/* The instance to remove. */
-    Class *clsPtr)		/* The class (possibly) containing the
-				 * reference to the instance. */
-{
-    int i;
-    Object *instPtr;
-
-    FOREACH(instPtr, clsPtr->instances) {
-	if (oPtr == instPtr) {
-	    goto removeInstance;
-	}
-    }
-    return;
-
-  removeInstance:
-    if (Deleted(clsPtr->thisPtr)) {
-	clsPtr->instances.list[i] = NULL;
-    } else {
-	clsPtr->instances.num--;
-	if (i < clsPtr->instances.num) {
-	    clsPtr->instances.list[i] =
-		    clsPtr->instances.list[clsPtr->instances.num];
-	}
-	clsPtr->instances.list[clsPtr->instances.num] = NULL;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOAddToInstances --
- *
- *	Utility function to add an object to the list of instances within a
- *	class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOAddToInstances(
-    Object *oPtr,		/* The instance to add. */
-    Class *clsPtr)		/* The class to add the instance to. It is
-				 * assumed that the class is not already
-				 * present as an instance in the class. */
-{
-    if (Deleted(clsPtr->thisPtr)) {
-	return;
-    }
-    if (clsPtr->instances.num >= clsPtr->instances.size) {
-	clsPtr->instances.size += ALLOC_CHUNK;
-	if (clsPtr->instances.size == ALLOC_CHUNK) {
-	    clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
-	} else {
-	    clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
-		    sizeof(Object *) * clsPtr->instances.size);
-	}
-    }
-    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOORemoveFromSubclasses --
- *
- *	Utility function to remove a class from the list of subclasses within
- *	another class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOORemoveFromSubclasses(
-    Class *subPtr,		/* The subclass to remove. */
-    Class *superPtr)		/* The superclass to (possibly) remove the
-				 * subclass reference from. */
-{
-    int i;
-    Class *subclsPtr;
-
-    FOREACH(subclsPtr, superPtr->subclasses) {
-	if (subPtr == subclsPtr) {
-	    goto removeSubclass;
-	}
-    }
-    return;
-
-  removeSubclass:
-    if (Deleted(superPtr->thisPtr)) {
-	superPtr->subclasses.list[i] = NULL;
-    } else {
-	superPtr->subclasses.num--;
-	if (i < superPtr->subclasses.num) {
-	    superPtr->subclasses.list[i] =
-		    superPtr->subclasses.list[superPtr->subclasses.num];
-	}
-	superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOAddToSubclasses --
- *
- *	Utility function to add a class to the list of subclasses within
- *	another class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOAddToSubclasses(
-    Class *subPtr,		/* The subclass to add. */
-    Class *superPtr)		/* The superclass to add the subclass to. It
-				 * is assumed that the class is not already
-				 * present as a subclass in the superclass. */
-{
-    if (Deleted(superPtr->thisPtr)) {
-	return;
-    }
-    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
-	superPtr->subclasses.size += ALLOC_CHUNK;
-	if (superPtr->subclasses.size == ALLOC_CHUNK) {
-	    superPtr->subclasses.list = ckalloc(sizeof(Class*) * ALLOC_CHUNK);
-	} else {
-	    superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
-		    sizeof(Class *) * superPtr->subclasses.size);
-	}
-    }
-    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOORemoveFromMixinSubs --
- *
- *	Utility function to remove a class from the list of mixinSubs within
- *	another class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOORemoveFromMixinSubs(
-    Class *subPtr,		/* The subclass to remove. */
-    Class *superPtr)		/* The superclass to (possibly) remove the
-				 * subclass reference from. */
-{
-    int i;
-    Class *subclsPtr;
-
-    FOREACH(subclsPtr, superPtr->mixinSubs) {
-	if (subPtr == subclsPtr) {
-	    goto removeSubclass;
-	}
-    }
-    return;
-
-  removeSubclass:
-    if (Deleted(superPtr->thisPtr)) {
-	superPtr->mixinSubs.list[i] = NULL;
-    } else {
-	superPtr->mixinSubs.num--;
-	if (i < superPtr->mixinSubs.num) {
-	    superPtr->mixinSubs.list[i] =
-		    superPtr->mixinSubs.list[superPtr->mixinSubs.num];
-	}
-	superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOAddToMixinSubs --
- *
- *	Utility function to add a class to the list of mixinSubs within
- *	another class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOAddToMixinSubs(
-    Class *subPtr,		/* The subclass to add. */
-    Class *superPtr)		/* The superclass to add the subclass to. It
-				 * is assumed that the class is not already
-				 * present as a subclass in the superclass. */
-{
-    if (Deleted(superPtr->thisPtr)) {
-	return;
-    }
-    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
-	superPtr->mixinSubs.size += ALLOC_CHUNK;
-	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
-	    superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
-	} else {
-	    superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
-		    sizeof(Class *) * superPtr->mixinSubs.size);
-	}
-    }
-    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * AllocClass --
- *
- *	Allocate a basic class. Does not splice the class object into its
- *	class's instance list.
- *
- * ----------------------------------------------------------------------
- */
-
-static Class *
-AllocClass(
-    Tcl_Interp *interp,		/* Interpreter within which to allocate the
-				 * class. */
-    Object *useThisObj)		/* Object that is to act as the class
-				 * representation, or NULL if a new object
-				 * (with automatic name) is to be used. */
-{
-    Foundation *fPtr = GetFoundation(interp);
-    Class *clsPtr = ckalloc(sizeof(Class));
-
-    /*
-     * Make an object if we haven't been given one.
-     */
-
-    memset(clsPtr, 0, sizeof(Class));
-    if (useThisObj == NULL) {
-	clsPtr->thisPtr = AllocObject(interp, NULL, NULL);
-    } else {
-	clsPtr->thisPtr = useThisObj;
-    }
-
-    /*
-     * Configure the namespace path for the class's object.
-     */
-
-    if (fPtr->helpersNs != NULL) {
-	Tcl_Namespace *path[2];
-
-	path[0] = fPtr->helpersNs;
-	path[1] = fPtr->ooNs;
-	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
-    } else {
-	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
-		&fPtr->ooNs);
-    }
-
-    /*
-     * Class objects inherit from the class of classes unless they inherit
-     * from some subclass of it. Enforce this right now.
-     */
-
-    clsPtr->thisPtr->selfCls = fPtr->classCls;
-
-    /*
-     * Classes are subclasses of oo::object, i.e. the objects they create are
-     * objects.
-     */
-
-    clsPtr->superclasses.num = 1;
-    clsPtr->superclasses.list = ckalloc(sizeof(Class *));
-    clsPtr->superclasses.list[0] = fPtr->objectCls;
-
-    /*
-     * Finish connecting the class structure to the object structure.
-     */
-
-    clsPtr->thisPtr->classPtr = clsPtr;
-
-    /*
-     * That's the complicated bit. Now fill in the rest of the non-zero/NULL
-     * fields.
-     */
-
-    clsPtr->refCount = 1;
-    Tcl_InitObjHashTable(&clsPtr->classMethods);
-    return clsPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_NewObjectInstance --
- *
- *	Allocate a new instance of an object.
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Object
-Tcl_NewObjectInstance(
-    Tcl_Interp *interp,		/* Interpreter context. */
-    Tcl_Class cls,		/* Class to create an instance of. */
-    const char *nameStr,	/* Name of object to create, or NULL to ask
-				 * the code to pick its own unique name. */
-    const char *nsNameStr,	/* Name of namespace to create inside object,
-				 * or NULL to ask the code to pick its own
-				 * unique name. */
-    int objc,			/* Number of arguments. Negative value means
-				 * do not call constructor. */
-    Tcl_Obj *const *objv,	/* Argument list. */
-    int skip)			/* Number of arguments to _not_ pass to the
-				 * constructor. */
-{
-    register Class *classPtr = (Class *) cls;
-    Foundation *fPtr = GetFoundation(interp);
-    Object *oPtr;
-
-    /*
-     * Check if we're going to create an object over an existing command;
-     * that's not allowed.
-     */
-
-    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
-	    TCL_NAMESPACE_ONLY)) {
-	Tcl_AppendResult(interp, "can't create object \"", nameStr,
-		"\": command already exists with that name", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
-	return NULL;
-    }
-
-    /*
-     * Create the object.
-     */
-
-    oPtr = AllocObject(interp, nameStr, nsNameStr);
-    oPtr->selfCls = classPtr;
-    TclOOAddToInstances(oPtr, classPtr);
-
-    /*
-     * Check to see if we're really creating a class. If so, allocate the
-     * class structure as well.
-     */
-
-    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
-	/*
-	 * Is a class, so attach a class structure. Note that the AllocClass
-	 * function splices the structure into the object, so we don't have
-	 * to. Once that's done, we need to repatch the object to have the
-	 * right class since AllocClass interferes with that.
-	 */
-
-	AllocClass(interp, oPtr);
-	oPtr->selfCls = classPtr;
-	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
-    }
-
-    /*
-     * Run constructors, except when objc < 0 (a special flag case used for
-     * object cloning only).
-     */
-
-    if (objc >= 0) {
-	CallContext *contextPtr =
-		TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
-
-	if (contextPtr != NULL) {
-	    int result;
-	    Tcl_InterpState state;
-
-	    state = Tcl_SaveInterpState(interp, TCL_OK);
-	    contextPtr->callPtr->flags |= CONSTRUCTOR;
-	    contextPtr->skip = skip;
-
-	    /*
-	     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
-	     */
-
-	    if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
-		((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
-		((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
-	    }
-	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
-		    objc, objv);
-
-	    /*
-	     * It's an error if the object was whacked in the constructor.
-	     * Force this if it isn't already an error (don't want to lose
-	     * errors by accident...) [Bug 2903011]
-	     */
-
-	    if (result != TCL_ERROR && Deleted(oPtr)) {
-		Tcl_SetResult(interp, "object deleted in constructor",
-			TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
-		result = TCL_ERROR;
-	    }
-	    TclOODeleteContext(contextPtr);
-	    if (result != TCL_OK) {
-		Tcl_DiscardInterpState(state);
-
-		/*
-		 * Take care to not delete a deleted object; that would be
-		 * bad. [Bug 2903011]
-		 */
-
-		if (!Deleted(oPtr)) {
-		    Tcl_DeleteCommandFromToken(interp, oPtr->command);
-		}
-		return NULL;
-	    }
-	    Tcl_RestoreInterpState(interp, state);
-	}
-    }
-
-    return (Tcl_Object) oPtr;
-}
-
-int
-TclNRNewObjectInstance(
-    Tcl_Interp *interp,		/* Interpreter context. */
-    Tcl_Class cls,		/* Class to create an instance of. */
-    const char *nameStr,	/* Name of object to create, or NULL to ask
-				 * the code to pick its own unique name. */
-    const char *nsNameStr,	/* Name of namespace to create inside object,
-				 * or NULL to ask the code to pick its own
-				 * unique name. */
-    int objc,			/* Number of arguments. Negative value means
-				 * do not call constructor. */
-    Tcl_Obj *const *objv,	/* Argument list. */
-    int skip,			/* Number of arguments to _not_ pass to the
-				 * constructor. */
-    Tcl_Object *objectPtr)	/* Place to write the object reference upon
-				 * successful allocation. */
-{
-    register Class *classPtr = (Class *) cls;
-    Foundation *fPtr = GetFoundation(interp);
-    CallContext *contextPtr;
-    Tcl_InterpState state;
-    Object *oPtr;
-
-    /*
-     * Check if we're going to create an object over an existing command;
-     * that's not allowed.
-     */
-
-    if (nameStr && Tcl_FindCommand(interp, nameStr, NULL,
-	    TCL_NAMESPACE_ONLY)) {
-	Tcl_AppendResult(interp, "can't create object \"", nameStr,
-		"\": command already exists with that name", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Create the object.
-     */
-
-    oPtr = AllocObject(interp, nameStr, nsNameStr);
-    oPtr->selfCls = classPtr;
-    TclOOAddToInstances(oPtr, classPtr);
-
-    /*
-     * Check to see if we're really creating a class. If so, allocate the
-     * class structure as well.
-     */
-
-    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
-	/*
-	 * Is a class, so attach a class structure. Note that the AllocClass
-	 * function splices the structure into the object, so we don't have
-	 * to. Once that's done, we need to repatch the object to have the
-	 * right class since AllocClass interferes with that.
-	 */
-
-	AllocClass(interp, oPtr);
-	oPtr->selfCls = classPtr;
-	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
-    }
-
-    /*
-     * Run constructors, except when objc < 0 (a special flag case used for
-     * object cloning only). If there aren't any constructors, we do nothing.
-     */
-
-    if (objc < 0) {
-	*objectPtr = (Tcl_Object) oPtr;
-	return TCL_OK;
-    }
-    contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
-    if (contextPtr == NULL) {
-	*objectPtr = (Tcl_Object) oPtr;
-	return TCL_OK;
-    }
-
-    state = Tcl_SaveInterpState(interp, TCL_OK);
-    contextPtr->callPtr->flags |= CONSTRUCTOR;
-    contextPtr->skip = skip;
-
-    /*
-     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
-     */
-
-    if (((Interp *) interp)->ensembleRewrite.sourceObjs) {
-	((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1;
-	((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1;
-    }
-
-    /*
-     * Fire off the constructors non-recursively.
-     */
-
-    AddRef(oPtr);
-    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
-	    objectPtr);
-    TclPushTailcallPoint(interp);
-    return TclOOInvokeContext(contextPtr, interp, objc, objv);
-}
-
-static int
-FinalizeAlloc(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CallContext *contextPtr = data[0];
-    Object *oPtr = data[1];
-    Tcl_InterpState state = data[2];
-    Tcl_Object *objectPtr = data[3];
-
-    /*
-     * It's an error if the object was whacked in the constructor. Force this
-     * if it isn't already an error (don't want to lose errors by accident...)
-     * [Bug 2903011]
-     */
-
-    if (result != TCL_ERROR && Deleted(oPtr)) {
-	Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
-	result = TCL_ERROR;
-    }
-    TclOODeleteContext(contextPtr);
-    if (result != TCL_OK) {
-	Tcl_DiscardInterpState(state);
-
-	/*
-	 * Take care to not delete a deleted object; that would be bad. [Bug
-	 * 2903011]
-	 */
-
-	if (!Deleted(oPtr)) {
-	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
-	}
-	DelRef(oPtr);
-	return TCL_ERROR;
-    }
-    Tcl_RestoreInterpState(interp, state);
-    *objectPtr = (Tcl_Object) oPtr;
-    DelRef(oPtr);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_CopyObjectInstance --
- *
- *	Creates a copy of an object. Does not copy the backing namespace,
- *	since the correct way to do that (e.g., shallow/deep) depends on the
- *	object/class's own policies.
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Object
-Tcl_CopyObjectInstance(
-    Tcl_Interp *interp,
-    Tcl_Object sourceObject,
-    const char *targetName,
-    const char *targetNamespaceName)
-{
-    Object *oPtr = (Object *) sourceObject, *o2Ptr;
-    FOREACH_HASH_DECLS;
-    Method *mPtr;
-    Class *mixinPtr;
-    CallContext *contextPtr;
-    Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
-    int i, result;
-
-    /*
-     * Sanity check.
-     */
-
-    if (IsRootClass(oPtr)) {
-	Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
-	return NULL;
-    }
-
-    /*
-     * Build the instance. Note that this does not run any constructors.
-     */
-
-    o2Ptr = (Object *) Tcl_NewObjectInstance(interp,
-	    (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, -1,
-	    NULL, -1);
-    if (o2Ptr == NULL) {
-	return NULL;
-    }
-
-    /*
-     * Copy the object-local methods to the new object.
-     */
-
-    if (oPtr->methodsPtr) {
-	FOREACH_HASH(keyPtr, mPtr, oPtr->methodsPtr) {
-	    if (CloneObjectMethod(interp, o2Ptr, mPtr, keyPtr) != TCL_OK) {
-		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
-		return NULL;
-	    }
-	}
-    }
-
-    /*
-     * Copy the object's mixin references to the new object.
-     */
-
-    FOREACH(mixinPtr, o2Ptr->mixins) {
-	if (mixinPtr != o2Ptr->selfCls) {
-	    TclOORemoveFromInstances(o2Ptr, mixinPtr);
-	}
-    }
-    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
-    FOREACH(mixinPtr, o2Ptr->mixins) {
-	if (mixinPtr != o2Ptr->selfCls) {
-	    TclOOAddToInstances(o2Ptr, mixinPtr);
-	}
-    }
-
-    /*
-     * Copy the object's filter list to the new object.
-     */
-
-    DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
-    FOREACH(filterObj, o2Ptr->filters) {
-	Tcl_IncrRefCount(filterObj);
-    }
-
-    /*
-     * Copy the object's variable resolution list to the new object.
-     */
-
-    DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
-    FOREACH(variableObj, o2Ptr->variables) {
-	Tcl_IncrRefCount(variableObj);
-    }
-
-    /*
-     * Copy the object's flags to the new object, clearing those that must be
-     * kept object-local. The duplicate is never deleted at this point, nor is
-     * it the root of the object system or in the midst of processing a filter
-     * call.
-     */
-
-    o2Ptr->flags = oPtr->flags & ~(
-	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
-
-    /*
-     * Copy the object's metadata.
-     */
-
-    if (oPtr->metadataPtr != NULL) {
-	Tcl_ObjectMetadataType *metadataTypePtr;
-	ClientData value, duplicate;
-
-	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
-	    if (metadataTypePtr->cloneProc == NULL) {
-		duplicate = value;
-	    } else {
-		if (metadataTypePtr->cloneProc(interp, value,
-			&duplicate) != TCL_OK) {
-		    Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
-		    return NULL;
-		}
-	    }
-	    if (duplicate != NULL) {
-		Tcl_ObjectSetMetadata((Tcl_Object) o2Ptr, metadataTypePtr,
-			duplicate);
-	    }
-	}
-    }
-
-    /*
-     * Copy the class, if present. Note that if there is a class present in
-     * the source object, there must also be one in the copy.
-     */
-
-    if (oPtr->classPtr != NULL) {
-	Class *clsPtr = oPtr->classPtr;
-	Class *cls2Ptr = o2Ptr->classPtr;
-	Class *superPtr;
-
-	/*
-	 * Copy the class flags across.
-	 */
-
-	cls2Ptr->flags = clsPtr->flags;
-
-	/*
-	 * Ensure that the new class's superclass structure is the same as the
-	 * old class's.
-	 */
-
-	FOREACH(superPtr, cls2Ptr->superclasses) {
-	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
-	}
-	if (cls2Ptr->superclasses.num) {
-	    cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
-		    sizeof(Class *) * clsPtr->superclasses.num);
-	} else {
-	    cls2Ptr->superclasses.list =
-		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
-	}
-	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
-		sizeof(Class *) * clsPtr->superclasses.num);
-	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
-	FOREACH(superPtr, cls2Ptr->superclasses) {
-	    TclOOAddToSubclasses(cls2Ptr, superPtr);
-	}
-
-	/*
-	 * Duplicate the source class's filters.
-	 */
-
-	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
-	FOREACH(filterObj, cls2Ptr->filters) {
-	    Tcl_IncrRefCount(filterObj);
-	}
-
-	/*
-	 * Copy the source class's variable resolution list.
-	 */
-
-	DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
-	FOREACH(variableObj, cls2Ptr->variables) {
-	    Tcl_IncrRefCount(variableObj);
-	}
-
-	/*
-	 * Duplicate the source class's mixins (which cannot be circular
-	 * references to the duplicate).
-	 */
-
-	FOREACH(mixinPtr, cls2Ptr->mixins) {
-	    TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
-	}
-	if (cls2Ptr->mixins.num != 0) {
-	    ckfree(clsPtr->mixins.list);
-	}
-	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
-	FOREACH(mixinPtr, cls2Ptr->mixins) {
-	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);
-	}
-
-	/*
-	 * Duplicate the source class's methods, constructor and destructor.
-	 */
-
-	FOREACH_HASH(keyPtr, mPtr, &clsPtr->classMethods) {
-	    if (CloneClassMethod(interp, cls2Ptr, mPtr, keyPtr,
-		    NULL) != TCL_OK) {
-		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
-		return NULL;
-	    }
-	}
-	if (clsPtr->constructorPtr) {
-	    if (CloneClassMethod(interp, cls2Ptr, clsPtr->constructorPtr,
-		    NULL, &cls2Ptr->constructorPtr) != TCL_OK) {
-		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
-		return NULL;
-	    }
-	}
-	if (clsPtr->destructorPtr) {
-	    if (CloneClassMethod(interp, cls2Ptr, clsPtr->destructorPtr, NULL,
-		    &cls2Ptr->destructorPtr) != TCL_OK) {
-		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
-		return NULL;
-	    }
-	}
-
-	/*
-	 * Duplicate the class's metadata.
-	 */
-
-	if (clsPtr->metadataPtr != NULL) {
-	    Tcl_ObjectMetadataType *metadataTypePtr;
-	    ClientData value, duplicate;
-
-	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
-		if (metadataTypePtr->cloneProc == NULL) {
-		    duplicate = value;
-		} else {
-		    if (metadataTypePtr->cloneProc(interp, value,
-			    &duplicate) != TCL_OK) {
-			Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
-			return NULL;
-		    }
-		}
-		if (duplicate != NULL) {
-		    Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr,
-			    duplicate);
-		}
-	    }
-	}
-    }
-
-    TclResetRewriteEnsemble(interp, 1);
-    contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
-    if (contextPtr) {
-	args[0] = TclOOObjectName(interp, o2Ptr);
-	args[1] = oPtr->fPtr->clonedName;
-	args[2] = TclOOObjectName(interp, oPtr);
-	Tcl_IncrRefCount(args[0]);
-	Tcl_IncrRefCount(args[1]);
-	Tcl_IncrRefCount(args[2]);
-	result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 3,
-		args);
-	TclDecrRefCount(args[0]);
-	TclDecrRefCount(args[1]);
-	TclDecrRefCount(args[2]);
-	TclOODeleteContext(contextPtr);
-	if (result == TCL_ERROR) {
-	    Tcl_AddErrorInfo(interp,
-		    "\n    (while performing post-copy callback)");
-	}
-	if (result != TCL_OK) {
-	    Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
-	    return NULL;
-	}
-    }
-
-    return (Tcl_Object) o2Ptr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * CloneObjectMethod, CloneClassMethod --
- *
- *	Helper functions used for cloning methods. They work identically to
- *	each other, except for the difference between them in how they
- *	register the cloned method on a successful clone.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-CloneObjectMethod(
-    Tcl_Interp *interp,
-    Object *oPtr,
-    Method *mPtr,
-    Tcl_Obj *namePtr)
-{
-    if (mPtr->typePtr == NULL) {
-	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
-		mPtr->flags & PUBLIC_METHOD, NULL, NULL);
-    } else if (mPtr->typePtr->cloneProc) {
-	ClientData newClientData;
-
-	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
-		&newClientData) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
-		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);
-    } else {
-	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
-		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData);
-    }
-    return TCL_OK;
-}
-
-static int
-CloneClassMethod(
-    Tcl_Interp *interp,
-    Class *clsPtr,
-    Method *mPtr,
-    Tcl_Obj *namePtr,
-    Method **m2PtrPtr)
-{
-    Method *m2Ptr;
-
-    if (mPtr->typePtr == NULL) {
-	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
-		namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
-    } else if (mPtr->typePtr->cloneProc) {
-	ClientData newClientData;
-
-	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
-		&newClientData) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
-		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
-		newClientData);
-    } else {
-	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
-		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
-		mPtr->clientData);
-    }
-    if (m2PtrPtr != NULL) {
-	*m2PtrPtr = m2Ptr;
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_ObjectGetMetadata,
- * Tcl_ObjectSetMetadata --
- *
- *	Metadata management API. The metadata system allows code in extensions
- *	to attach arbitrary non-NULL pointers to objects and classes without
- *	the different things that might be interested being able to interfere
- *	with each other. Apart from non-NULL-ness, these routines attach no
- *	interpretation to the meaning of the metadata pointers.
- *
- *	The Tcl_*GetMetadata routines get the metadata pointer attached that
- *	has been related with a particular type, or NULL if no metadata
- *	associated with the given type has been attached.
- *
- *	The Tcl_*SetMetadata routines set or delete the metadata pointer that
- *	is related to a particular type. The value associated with the type is
- *	deleted (if present; no-op otherwise) if the value is NULL, and
- *	attached (replacing the previous value, which is deleted if present)
- *	otherwise. This means it is impossible to attach a NULL value for any
- *	metadata type.
- *
- * ----------------------------------------------------------------------
- */
-
-ClientData
-Tcl_ClassGetMetadata(
-    Tcl_Class clazz,
-    const Tcl_ObjectMetadataType *typePtr)
-{
-    Class *clsPtr = (Class *) clazz;
-    Tcl_HashEntry *hPtr;
-
-    /*
-     * If there's no metadata store attached, the type in question has
-     * definitely not been attached either!
-     */
-
-    if (clsPtr->metadataPtr == NULL) {
-	return NULL;
-    }
-
-    /*
-     * There is a metadata store, so look in it for the given type.
-     */
-
-    hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);
-
-    /*
-     * Return the metadata value if we found it, otherwise NULL.
-     */
-
-    if (hPtr == NULL) {
-	return NULL;
-    }
-    return Tcl_GetHashValue(hPtr);
-}
-
-void
-Tcl_ClassSetMetadata(
-    Tcl_Class clazz,
-    const Tcl_ObjectMetadataType *typePtr,
-    ClientData metadata)
-{
-    Class *clsPtr = (Class *) clazz;
-    Tcl_HashEntry *hPtr;
-    int isNew;
-
-    /*
-     * Attach the metadata store if not done already.
-     */
-
-    if (clsPtr->metadataPtr == NULL) {
-	if (metadata == NULL) {
-	    return;
-	}
-	clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
-    }
-
-    /*
-     * If the metadata is NULL, we're deleting the metadata for the type.
-     */
-
-    if (metadata == NULL) {
-	hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);
-	if (hPtr != NULL) {
-	    typePtr->deleteProc(Tcl_GetHashValue(hPtr));
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-	return;
-    }
-
-    /*
-     * Otherwise we're attaching the metadata. Note that if there was already
-     * some metadata attached of this type, we delete that first.
-     */
-
-    hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, (char *) typePtr, &isNew);
-    if (!isNew) {
-	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
-    }
-    Tcl_SetHashValue(hPtr, metadata);
-}
-
-ClientData
-Tcl_ObjectGetMetadata(
-    Tcl_Object object,
-    const Tcl_ObjectMetadataType *typePtr)
-{
-    Object *oPtr = (Object *) object;
-    Tcl_HashEntry *hPtr;
-
-    /*
-     * If there's no metadata store attached, the type in question has
-     * definitely not been attached either!
-     */
-
-    if (oPtr->metadataPtr == NULL) {
-	return NULL;
-    }
-
-    /*
-     * There is a metadata store, so look in it for the given type.
-     */
-
-    hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);
-
-    /*
-     * Return the metadata value if we found it, otherwise NULL.
-     */
-
-    if (hPtr == NULL) {
-	return NULL;
-    }
-    return Tcl_GetHashValue(hPtr);
-}
-
-void
-Tcl_ObjectSetMetadata(
-    Tcl_Object object,
-    const Tcl_ObjectMetadataType *typePtr,
-    ClientData metadata)
-{
-    Object *oPtr = (Object *) object;
-    Tcl_HashEntry *hPtr;
-    int isNew;
-
-    /*
-     * Attach the metadata store if not done already.
-     */
-
-    if (oPtr->metadataPtr == NULL) {
-	if (metadata == NULL) {
-	    return;
-	}
-	oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
-    }
-
-    /*
-     * If the metadata is NULL, we're deleting the metadata for the type.
-     */
-
-    if (metadata == NULL) {
-	hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);
-	if (hPtr != NULL) {
-	    typePtr->deleteProc(Tcl_GetHashValue(hPtr));
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-	return;
-    }
-
-    /*
-     * Otherwise we're attaching the metadata. Note that if there was already
-     * some metadata attached of this type, we delete that first.
-     */
-
-    hPtr = Tcl_CreateHashEntry(oPtr->metadataPtr, (char *) typePtr, &isNew);
-    if (!isNew) {
-	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
-    }
-    Tcl_SetHashValue(hPtr, metadata);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
- *
- *	Main entry point for object invokations. The Public* and Private*
- *	wrapper functions (implementations of both object instance commands
- *	and [my]) are just thin wrappers round the main TclOOObjectCmdCore
- *	function. Note that the core is function is NRE-aware.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-PublicObjectCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
-}
-
-static int
-PublicNRObjectCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
-	    NULL);
-}
-
-static int
-PrivateObjectCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
-}
-
-static int
-PrivateNRObjectCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL);
-}
-
-int
-TclOOInvokeObject(
-    Tcl_Interp *interp,		/* Interpreter for commands, variables,
-				 * results, error reporting, etc. */
-    Tcl_Object object,		/* The object to invoke. */
-    Tcl_Class startCls,		/* Where in the class chain to start the
-				 * invoke from, or NULL to traverse the whole
-				 * chain including filters. */
-    int publicPrivate,		/* Whether this is an invoke from a public
-				 * context (PUBLIC_METHOD), a private context
-				 * (PRIVATE_METHOD), or a *really* private
-				 * context (any other value; conventionally
-				 * 0). */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* Array of argument objects. It is assumed
-				 * that the name of the method to invoke will
-				 * be at index 1. */
-{
-    switch (publicPrivate) {
-    case PUBLIC_METHOD:
-	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
-		PUBLIC_METHOD, (Class *) startCls);
-    case PRIVATE_METHOD:
-	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
-		PRIVATE_METHOD, (Class *) startCls);
-    default:
-	return TclOOObjectCmdCore((Object *) object, interp, objc, objv, 0,
-		(Class *) startCls);
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOObjectCmdCore, FinalizeObjectCall --
- *
- *	Main function for object invokations. Does call chain creation,
- *	management and invokation. The function FinalizeObjectCall exists to
- *	clean up after the non-recursive processing of TclOOObjectCmdCore.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOObjectCmdCore(
-    Object *oPtr,		/* The object being invoked. */
-    Tcl_Interp *interp,		/* The interpreter containing the object. */
-    int objc,			/* How many arguments are being passed in. */
-    Tcl_Obj *const *objv,	/* The array of arguments. */
-    int flags,			/* Whether this is an invokation through the
-				 * public or the private command interface. */
-    Class *startCls)		/* Where to start in the call chain, or NULL
-				 * if we are to start at the front with
-				 * filters and the object's methods (which is
-				 * the normal case). */
-{
-    CallContext *contextPtr;
-    Tcl_Obj *methodNamePtr;
-    int result;
-
-    /*
-     * If we've no method name, throw this directly into the unknown
-     * processing.
-     */
-
-    if (objc < 2) {
-	flags |= FORCE_UNKNOWN;
-	methodNamePtr = NULL;
-	goto noMapping;
-    }
-
-    /*
-     * Give plugged in code a chance to remap the method name.
-     */
-
-    methodNamePtr = objv[1];
-    if (oPtr->mapMethodNameProc != NULL) {
-	register Class **startClsPtr = &startCls;
-	Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr);
-
-	result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
-		(Tcl_Class *) startClsPtr, mappedMethodName);
-	if (result != TCL_OK) {
-	    Tcl_DecrRefCount(mappedMethodName);
-	    if (result == TCL_BREAK) {
-		goto noMapping;
-	    } else if (result == TCL_ERROR) {
-		Tcl_AddErrorInfo(interp, "\n    (while mapping method name)");
-	    }
-	    return result;
-	}
-
-	/*
-	 * Get the call chain for the remapped name.
-	 */
-
-	Tcl_IncrRefCount(mappedMethodName);
-	contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
-		flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
-	Tcl_DecrRefCount(mappedMethodName);
-	if (contextPtr == NULL) {
-	    Tcl_AppendResult(interp, "impossible to invoke method \"",
-		    TclGetString(methodNamePtr),
-		    "\": no defined method or unknown method", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
-		    TclGetString(methodNamePtr), NULL);
-	    return TCL_ERROR;
-	}
-    } else {
-	/*
-	 * Get the call chain.
-	 */
-
-    noMapping:
-	contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
-		flags | (oPtr->flags & FILTER_HANDLING), NULL);
-	if (contextPtr == NULL) {
-	    Tcl_AppendResult(interp, "impossible to invoke method \"",
-		    TclGetString(methodNamePtr),
-		    "\": no defined method or unknown method", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		    TclGetString(methodNamePtr), NULL);
-	    return TCL_ERROR;
-	}
-    }
-
-    /*
-     * Check to see if we need to apply magical tricks to start part way
-     * through the call chain.
-     */
-
-    if (startCls != NULL) {
-	for (; contextPtr->index < contextPtr->callPtr->numChain;
-		contextPtr->index++) {
-	    register struct MInvoke *miPtr =
-		    &contextPtr->callPtr->chain[contextPtr->index];
-
-	    if (miPtr->isFilter) {
-		continue;
-	    }
-	    if (miPtr->mPtr->declaringClassPtr == startCls) {
-		break;
-	    }
-	}
-	if (contextPtr->index >= contextPtr->callPtr->numChain) {
-	    Tcl_SetResult(interp, "no valid method implementation",
-		    TCL_STATIC);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		    TclGetString(methodNamePtr), NULL);
-	    TclOODeleteContext(contextPtr);
-	    return TCL_ERROR;
-	}
-    }
-
-    /*
-     * Invoke the call chain, locking the object structure against deletion
-     * for the duration.
-     */
-
-    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
-    return TclOOInvokeContext(contextPtr, interp, objc, objv);
-}
-
-static int
-FinalizeObjectCall(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    /*
-     * Dispose of the call chain, which drops the lock on the object's
-     * structure.
-     */
-
-    TclOODeleteContext(data[0]);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_ObjectContextInvokeNext, TclNRObjectContextInvokeNext, FinalizeNext --
- *
- *	Invokes the next stage of the call chain described in an object
- *	context. This is the core of the implementation of the [next] command.
- *	Does not do management of the call-frame stack. Available in public
- *	(standard API) and private (NRE-aware) forms. FinalizeNext is a
- *	private function used to clean up in the NRE case.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-Tcl_ObjectContextInvokeNext(
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv,
-    int skip)
-{
-    CallContext *contextPtr = (CallContext *) context;
-    int savedIndex = contextPtr->index;
-    int savedSkip = contextPtr->skip;
-    int result;
-
-    if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
-	/*
-	 * We're at the end of the chain; generate an error message unless the
-	 * interpreter is being torn down, in which case we might be getting
-	 * here because of methods/destructors doing a [next] (or equivalent)
-	 * unexpectedly.
-	 */
-
-	const char *methodType;
-
-	if (Tcl_InterpDeleted(interp)) {
-	    return TCL_OK;
-	}
-
-	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
-	    methodType = "constructor";
-	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
-	    methodType = "destructor";
-	} else {
-	    methodType = "method";
-	}
-
-	Tcl_AppendResult(interp, "no next ", methodType, " implementation",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Advance to the next method implementation in the chain in the method
-     * call context while we process the body. However, need to adjust the
-     * argument-skip control because we're guaranteed to have a single prefix
-     * arg (i.e., 'next') and not the variable amount that can happen because
-     * method invokations (i.e., '$obj meth' and 'my meth'), constructors
-     * (i.e., '$cls new' and '$cls create obj') and destructors (no args at
-     * all) come through the same code.
-     */
-
-    contextPtr->index++;
-    contextPtr->skip = skip;
-
-    /*
-     * Invoke the (advanced) method call context in the caller context.
-     */
-
-    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc,
-	    objv);
-
-    /*
-     * Restore the call chain context index as we've finished the inner invoke
-     * and want to operate in the outer context again.
-     */
-
-    contextPtr->index = savedIndex;
-    contextPtr->skip = savedSkip;
-
-    return result;
-}
-
-int
-TclNRObjectContextInvokeNext(
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv,
-    int skip)
-{
-    register CallContext *contextPtr = (CallContext *) context;
-
-    if (contextPtr->index+1 >= contextPtr->callPtr->numChain) {
-	/*
-	 * We're at the end of the chain; generate an error message unless the
-	 * interpreter is being torn down, in which case we might be getting
-	 * here because of methods/destructors doing a [next] (or equivalent)
-	 * unexpectedly.
-	 */
-
-	const char *methodType;
-
-	if (Tcl_InterpDeleted(interp)) {
-	    return TCL_OK;
-	}
-
-	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
-	    methodType = "constructor";
-	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
-	    methodType = "destructor";
-	} else {
-	    methodType = "method";
-	}
-
-	Tcl_AppendResult(interp, "no next ", methodType, " implementation",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Advance to the next method implementation in the chain in the method
-     * call context while we process the body. However, need to adjust the
-     * argument-skip control because we're guaranteed to have a single prefix
-     * arg (i.e., 'next') and not the variable amount that can happen because
-     * method invokations (i.e., '$obj meth' and 'my meth'), constructors
-     * (i.e., '$cls new' and '$cls create obj') and destructors (no args at
-     * all) come through the same code.
-     */
-
-    TclNRAddCallback(interp, FinalizeNext, contextPtr,
-	    INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL);
-    contextPtr->index++;
-    contextPtr->skip = skip;
-
-    /*
-     * Invoke the (advanced) method call context in the caller context.
-     */
-
-    return TclOOInvokeContext(contextPtr, interp, objc, objv);
-}
-
-static int
-FinalizeNext(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CallContext *contextPtr = data[0];
-
-    /*
-     * Restore the call chain context index as we've finished the inner invoke
-     * and want to operate in the outer context again.
-     */
-
-    contextPtr->index = PTR2INT(data[1]);
-    contextPtr->skip = PTR2INT(data[2]);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_GetObjectFromObj --
- *
- *	Utility function to get an object from a Tcl_Obj containing its name.
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Object
-Tcl_GetObjectFromObj(
-    Tcl_Interp *interp,		/* Interpreter in which to locate the object.
-				 * Will have an error message placed in it if
-				 * the name does not refer to an object. */
-    Tcl_Obj *objPtr)		/* The name of the object to look up, which is
-				 * exactly the name of its public command. */
-{
-    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);
-
-    if (cmdPtr == NULL) {
-	goto notAnObject;
-    }
-    if (cmdPtr->objProc != PublicObjectCmd) {
-	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
-	if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
-	    goto notAnObject;
-	}
-    }
-    return cmdPtr->objClientData;
-
-  notAnObject:
-    Tcl_AppendResult(interp, TclGetString(objPtr),
-	    " does not refer to an object", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
-	    NULL);
-    return NULL;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOIsReachable --
- *
- *	Utility function that tests whether a class is a subclass (whether
- *	directly or indirectly) of another class.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOIsReachable(
-    Class *targetPtr,
-    Class *startPtr)
-{
-    int i;
-    Class *superPtr;
-
-  tailRecurse:
-    if (startPtr == targetPtr) {
-	return 1;
-    }
-    if (startPtr->superclasses.num == 1 && startPtr->mixins.num == 0) {
-	startPtr = startPtr->superclasses.list[0];
-	goto tailRecurse;
-    }
-    FOREACH(superPtr, startPtr->superclasses) {
-	if (TclOOIsReachable(targetPtr, superPtr)) {
-	    return 1;
-	}
-    }
-    FOREACH(superPtr, startPtr->mixins) {
-	if (TclOOIsReachable(targetPtr, superPtr)) {
-	    return 1;
-	}
-    }
-    return 0;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOObjectName, Tcl_GetObjectName --
- *
- *	Utility function that returns the name of the object. Note that this
- *	simplifies cache management by keeping the code to do it in one place
- *	and not sprayed all over. The value returned always has a reference
- *	count of at least one.
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclOOObjectName(
-    Tcl_Interp *interp,
-    Object *oPtr)
-{
-    Tcl_Obj *namePtr;
-
-    if (oPtr->cachedNameObj) {
-	return oPtr->cachedNameObj;
-    }
-    namePtr = Tcl_NewObj();
-    Tcl_GetCommandFullName(interp, oPtr->command, namePtr);
-    Tcl_IncrRefCount(namePtr);
-    oPtr->cachedNameObj = namePtr;
-    return namePtr;
-}
-
-Tcl_Obj *
-Tcl_GetObjectName(
-    Tcl_Interp *interp,
-    Tcl_Object object)
-{
-    return TclOOObjectName(interp, (Object *) object);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * assorted trivial 'getter' functions
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Method
-Tcl_ObjectContextMethod(
-    Tcl_ObjectContext context)
-{
-    CallContext *contextPtr = (CallContext *) context;
-    return (Tcl_Method) contextPtr->callPtr->chain[contextPtr->index].mPtr;
-}
-
-int
-Tcl_ObjectContextIsFiltering(
-    Tcl_ObjectContext context)
-{
-    CallContext *contextPtr = (CallContext *) context;
-    return contextPtr->callPtr->chain[contextPtr->index].isFilter;
-}
-
-Tcl_Object
-Tcl_ObjectContextObject(
-    Tcl_ObjectContext context)
-{
-    return (Tcl_Object) ((CallContext *)context)->oPtr;
-}
-
-int
-Tcl_ObjectContextSkippedArgs(
-    Tcl_ObjectContext context)
-{
-    return ((CallContext *)context)->skip;
-}
-
-Tcl_Namespace *
-Tcl_GetObjectNamespace(
-    Tcl_Object object)
-{
-    return ((Object *)object)->namespacePtr;
-}
-
-Tcl_Command
-Tcl_GetObjectCommand(
-    Tcl_Object object)
-{
-    return ((Object *)object)->command;
-}
-
-Tcl_Class
-Tcl_GetObjectAsClass(
-    Tcl_Object object)
-{
-    return (Tcl_Class) ((Object *)object)->classPtr;
-}
-
-int
-Tcl_ObjectDeleted(
-    Tcl_Object object)
-{
-    return Deleted(object) ? 1 : 0;
-}
-
-Tcl_Object
-Tcl_GetClassAsObject(
-    Tcl_Class clazz)
-{
-    return (Tcl_Object) ((Class *)clazz)->thisPtr;
-}
-
-Tcl_ObjectMapMethodNameProc *
-Tcl_ObjectGetMethodNameMapper(
-    Tcl_Object object)
-{
-    return ((Object *) object)->mapMethodNameProc;
-}
-
-void
-Tcl_ObjectSetMethodNameMapper(
-    Tcl_Object object,
-    Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
-{
-    ((Object *) object)->mapMethodNameProc = mapMethodNameProc;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
deleted file mode 100644
index 31d1113..0000000
--- a/generic/tclOO.decls
+++ /dev/null
@@ -1,204 +0,0 @@
-library tclOO
-
-######################################################################
-# public API
-#
-
-interface tclOO
-hooks tclOOInt
-scspec TCLOOAPI
-
-declare 0 {
-    Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
-	    Tcl_Object sourceObject, const char *targetName,
-	    const char *targetNamespaceName)
-}
-declare 1 {
-    Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz)
-}
-declare 2 {
-    Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object)
-}
-declare 3 {
-    Tcl_Command Tcl_GetObjectCommand(Tcl_Object object)
-}
-declare 4 {
-    Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
-}
-declare 5 {
-    Tcl_Namespace *Tcl_GetObjectNamespace(Tcl_Object object)
-}
-declare 6 {
-    Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method)
-}
-declare 7 {
-    Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method)
-}
-declare 8 {
-    int Tcl_MethodIsPublic(Tcl_Method method)
-}
-declare 9 {
-    int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr,
-	    ClientData *clientDataPtr)
-}
-declare 10 {
-    Tcl_Obj *Tcl_MethodName(Tcl_Method method)
-}
-declare 11 {
-    Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
-	    Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
-	    ClientData clientData)
-}
-declare 12 {
-    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
-	    Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
-	    ClientData clientData)
-}
-declare 13 {
-    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
-	    const char *nameStr, const char *nsNameStr, int objc,
-	    Tcl_Obj *const *objv, int skip)
-}
-declare 14 {
-    int Tcl_ObjectDeleted(Tcl_Object object)
-}
-declare 15 {
-    int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context)
-}
-declare 16 {
-    Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context)
-}
-declare 17 {
-    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
-}
-declare 18 {
-    int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
-}
-declare 19 {
-    ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
-	    const Tcl_ObjectMetadataType *typePtr)
-}
-declare 20 {
-    void Tcl_ClassSetMetadata(Tcl_Class clazz,
-	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
-}
-declare 21 {
-    ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
-	    const Tcl_ObjectMetadataType *typePtr)
-}
-declare 22 {
-    void Tcl_ObjectSetMetadata(Tcl_Object object,
-	    const Tcl_ObjectMetadataType *typePtr, ClientData metadata)
-}
-declare 23 {
-    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
-	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
-	    int skip)
-}
-declare 24 {
-    Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper(
-	    Tcl_Object object)
-}
-declare 25 {
-    void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
-	    Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
-}
-declare 26 {
-    void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz,
-	    Tcl_Method method)
-}
-declare 27 {
-    void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
-	    Tcl_Method method)
-}
-declare 28 {
-    Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
-}
-
-######################################################################
-# private API, exposed to support advanced OO systems that plug in on top
-#
-
-interface tclOOInt
-
-declare 0 {
-    Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp)
-}
-declare 1 {
-    Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
-	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-	    const Tcl_MethodType *typePtr, ClientData clientData,
-	    Proc **procPtrPtr)
-}
-declare 2 {
-    Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr,
-	    int flags, Tcl_Obj *nameObj, const char *namePtr,
-	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr,
-	    ClientData clientData, Proc **procPtrPtr)
-}
-declare 3 {
-    Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
-	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-	    ProcedureMethod **pmPtrPtr)
-}
-declare 4 {
-    Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
-	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-	    ProcedureMethod **pmPtrPtr)
-}
-declare 5 {
-    int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc,
-	    Tcl_Obj *const *objv, int publicOnly, Class *startCls)
-}
-declare 6 {
-    int TclOOIsReachable(Class *targetPtr, Class *startPtr)
-}
-declare 7 {
-    Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr,
-	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
-}
-declare 8 {
-    Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
-	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
-}
-declare 9 {
-    Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
-	    Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr,
-	    TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc,
-	    ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
-	    Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
-}
-declare 10 {
-    Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
-	    TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
-	    ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj,
-	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
-	    void **internalTokenPtr)
-}
-declare 11 {
-    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
-	    Tcl_Class startCls, int publicPrivate, int objc,
-	    Tcl_Obj *const *objv)
-}
-declare 12 {
-    void TclOOObjectSetFilters(Object *oPtr, int numFilters,
-	    Tcl_Obj *const *filters)
-}
-declare 13 {
-    void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr,
-	    int numFilters, Tcl_Obj *const *filters)
-}
-declare 14 {
-    void TclOOObjectSetMixins(Object *oPtr, int numMixins,
-	    Class *const *mixins)
-}
-declare 15 {
-    void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
-	    int numMixins, Class *const *mixins)
-}
-
-return
-
-# Local Variables:
-# mode: tcl
-# End:
diff --git a/generic/tclOO.h b/generic/tclOO.h
deleted file mode 100644
index fef2bd0..0000000
--- a/generic/tclOO.h
+++ /dev/null
@@ -1,140 +0,0 @@
-/*
- * tclOO.h --
- *
- *	This file contains the public API definitions and some of the function
- *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
- *
- * Copyright (c) 2006-2008 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.
- */
-
-#ifndef TCLOO_H_INCLUDED
-#define TCLOO_H_INCLUDED
-#include "tcl.h"
-
-#ifndef TCLOOAPI
-#   if defined(BUILD_tcl) || defined(BUILD_TclOO)
-#	define TCLOOAPI MODULE_SCOPE
-#   else
-#	define TCLOOAPI extern
-#	undef USE_TCLOO_STUBS
-#	define USE_TCLOO_STUBS 1
-#   endif
-#endif
-
-extern const char *TclOOInitializeStubs(
-	Tcl_Interp *, const char *version);
-#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp), TCLOO_VERSION)
-
-/*
- * Be careful when it comes to versioning; need to make sure that the
- * standalone TclOO version matches. Also make sure that this matches the
- * version in the files:
- *
- * tests/oo.test
- * unix/tclooConfig.sh
- * win/tclooConfig.sh
- */
-
-#define TCLOO_VERSION "0.6.3"
-#define TCLOO_PATCHLEVEL TCLOO_VERSION
-
-/*
- * These are opaque types.
- */
-
-typedef struct Tcl_Class_ *Tcl_Class;
-typedef struct Tcl_Method_ *Tcl_Method;
-typedef struct Tcl_Object_ *Tcl_Object;
-typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
-
-/*
- * Public datatypes for callbacks and structures used in the TIP#257 (OO)
- * implementation. These are used to implement custom types of method calls
- * and to allow the attachment of arbitrary data to objects and classes.
- */
-
-typedef int (Tcl_MethodCallProc)(ClientData clientData, Tcl_Interp *interp,
-	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
-typedef void (Tcl_MethodDeleteProc)(ClientData clientData);
-typedef int (Tcl_CloneProc)(Tcl_Interp *interp, ClientData oldClientData,
-	ClientData *newClientData);
-typedef void (Tcl_ObjectMetadataDeleteProc)(ClientData clientData);
-typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
-	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);
-
-/*
- * The type of a method implementation. This describes how to call the method
- * implementation, how to delete it (when the object or class is deleted) and
- * how to create a clone of it (when the object or class is copied).
- */
-
-typedef struct {
-    int version;		/* Structure version field. Always to be equal
-				 * to TCL_OO_METHOD_VERSION_CURRENT in
-				 * declarations. */
-    const char *name;		/* Name of this type of method, mostly for
-				 * debugging purposes. */
-    Tcl_MethodCallProc *callProc;
-				/* How to invoke this method. */
-    Tcl_MethodDeleteProc *deleteProc;
-				/* How to delete this method's type-specific
-				 * data, or NULL if the type-specific data
-				 * does not need deleting. */
-    Tcl_CloneProc *cloneProc;	/* How to copy this method's type-specific
-				 * data, or NULL if the type-specific data can
-				 * be copied directly. */
-} Tcl_MethodType;
-
-/*
- * The correct value for the version field of the Tcl_MethodType structure.
- * This allows new versions of the structure to be introduced without breaking
- * binary compatability.
- */
-
-#define TCL_OO_METHOD_VERSION_CURRENT 1
-
-/*
- * The type of some object (or class) metadata. This describes how to delete
- * the metadata (when the object or class is deleted) and how to create a
- * clone of it (when the object or class is copied).
- */
-
-typedef struct {
-    int version;		/* Structure version field. Always to be equal
-				 * to TCL_OO_METADATA_VERSION_CURRENT in
-				 * declarations. */
-    const char *name;
-    Tcl_ObjectMetadataDeleteProc *deleteProc;
-				/* How to delete the metadata. This must not
-				 * be NULL. */
-    Tcl_CloneProc *cloneProc;	/* How to copy the metadata, or NULL if the
-				 * type-specific data can be copied
-				 * directly. */
-} Tcl_ObjectMetadataType;
-
-/*
- * The correct value for the version field of the Tcl_ObjectMetadataType
- * structure. This allows new versions of the structure to be introduced
- * without breaking binary compatability.
- */
-
-#define TCL_OO_METADATA_VERSION_CURRENT 1
-
-/*
- * Include all the public API, generated from tclOO.decls.
- */
-
-#include "tclOODecls.h"
-
-#endif
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
deleted file mode 100644
index 329f0a4..0000000
--- a/generic/tclOOBasic.c
+++ /dev/null
@@ -1,1217 +0,0 @@
-/*
- * tclOOBasic.c --
- *
- *	This file contains implementations of the "simple" commands and
- *	methods from the object-system core.
- *
- * Copyright (c) 2005-2011 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.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "tclInt.h"
-#include "tclOOInt.h"
-
-static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
-static int		AfterNRDestructor(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		FinalizeConstruction(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		FinalizeEval(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		RestoreFrame(ClientData data[],
-			    Tcl_Interp *interp, int result);
-
-/*
- * ----------------------------------------------------------------------
- *
- * AddCreateCallback, FinalizeConstruction --
- *
- *	Special version of TclNRAddCallback that allows the caller to splice
- *	the object created later on. Always calls FinalizeConstruction, which
- *	converts the object into its name and stores that in the interpreter
- *	result. This is shared by all the construction methods (create,
- *	createWithNamespace, new).
- *
- *	Note that this is the only code in this file (or, indeed, the whole of
- *	TclOO) that uses NRE internals; it is the only code that does
- *	non-standard poking in the NRE guts.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline Tcl_Object *
-AddConstructionFinalizer(
-    Tcl_Interp *interp)
-{
-    TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
-    return (Tcl_Object *) &(TOP_CB(interp)->data[0]);
-}
-
-static int
-FinalizeConstruction(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Object *oPtr = data[0];
-
-    if (result != TCL_OK) {
-	return result;
-    }
-    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Class_Create --
- *
- *	Implementation for oo::class->create method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Class_Create(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
-    const char *objName;
-    int len;
-
-    /*
-     * Sanity check; should not be possible to invoke this method on a
-     * non-class.
-     */
-
-    if (oPtr->classPtr == NULL) {
-	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
-
-	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
-		"\" is not a class", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Check we have the right number of (sensible) arguments.
-     */
-
-    if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"objectName ?arg ...?");
-	return TCL_ERROR;
-    }
-    objName = Tcl_GetStringFromObj(
-	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
-    if (len == 0) {
-	Tcl_AppendResult(interp, "object name must not be empty", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the object and return its name.
-     */
-
-    return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
-	    objName, NULL, objc, objv,
-	    Tcl_ObjectContextSkippedArgs(context)+1,
-	    AddConstructionFinalizer(interp));
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Class_CreateNs --
- *
- *	Implementation for oo::class->createWithNamespace method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Class_CreateNs(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
-    const char *objName, *nsName;
-    int len;
-
-    /*
-     * Sanity check; should not be possible to invoke this method on a
-     * non-class.
-     */
-
-    if (oPtr->classPtr == NULL) {
-	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
-
-	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
-		"\" is not a class", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Check we have the right number of (sensible) arguments.
-     */
-
-    if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"objectName namespaceName ?arg ...?");
-	return TCL_ERROR;
-    }
-    objName = Tcl_GetStringFromObj(
-	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
-    if (len == 0) {
-	Tcl_AppendResult(interp, "object name must not be empty", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
-	return TCL_ERROR;
-    }
-    nsName = Tcl_GetStringFromObj(
-	    objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
-    if (len == 0) {
-	Tcl_AppendResult(interp, "namespace name must not be empty", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the object and return its name.
-     */
-
-    return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
-	    objName, nsName, objc, objv,
-	    Tcl_ObjectContextSkippedArgs(context)+2,
-	    AddConstructionFinalizer(interp));
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Class_New --
- *
- *	Implementation for oo::class->new method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Class_New(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
-
-    /*
-     * Sanity check; should not be possible to invoke this method on a
-     * non-class.
-     */
-
-    if (oPtr->classPtr == NULL) {
-	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);
-
-	Tcl_AppendResult(interp, "object \"", TclGetString(cmdnameObj),
-		"\" is not a class", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the object and return its name.
-     */
-
-    return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
-	    NULL, NULL, objc, objv, Tcl_ObjectContextSkippedArgs(context),
-	    AddConstructionFinalizer(interp));
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Object_Destroy --
- *
- *	Implementation for oo::object->destroy method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Object_Destroy(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
-    CallContext *contextPtr;
-
-    if (objc != Tcl_ObjectContextSkippedArgs(context)) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    }
-    if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
-	oPtr->flags |= DESTRUCTOR_CALLED;
-	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
-	if (contextPtr != NULL) {
-	    contextPtr->callPtr->flags |= DESTRUCTOR;
-	    contextPtr->skip = 0;
-	    TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
-		    NULL, NULL, NULL);
-	    TclPushTailcallPoint(interp);
-	    return TclOOInvokeContext(contextPtr, interp, 0, NULL);
-	}
-    }
-    if (oPtr->command) {
-	Tcl_DeleteCommandFromToken(interp, oPtr->command);
-    }
-    return TCL_OK;
-}
-
-static int
-AfterNRDestructor(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CallContext *contextPtr = data[0];
-
-    if (contextPtr->oPtr->command) {
-	Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
-    }
-    TclOODeleteContext(contextPtr);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Object_Eval --
- *
- *	Implementation for oo::object->eval method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Object_Eval(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    CallContext *contextPtr = (CallContext *) context;
-    Tcl_Object object = Tcl_ObjectContextObject(context);
-    register const int skip = Tcl_ObjectContextSkippedArgs(context);
-    CallFrame *framePtr, **framePtrPtr = &framePtr;
-    Tcl_Obj *scriptPtr;
-    int result;
-    CmdFrame *invoker;
-
-    if (objc-1 < skip) {
-	Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the object's namespace the current namespace and evaluate the
-     * command(s).
-     */
-
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
-	    Tcl_GetObjectNamespace(object), 0);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-    framePtr->objc = objc;
-    framePtr->objv = objv;	/* Reference counts do not need to be
-				 * incremented here. */
-
-    if (!(contextPtr->callPtr->flags & PUBLIC_METHOD)) {
-	object = NULL;		/* Now just for error mesage printing. */
-    }
-
-    /*
-     * Work out what script we are actually going to evaluate.
-     *
-     * When there's more than one argument, we 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.
-     */
-
-    if (objc != skip+1) {
-	scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
-	invoker = NULL;
-    } else {
-	scriptPtr = objv[skip];
-	invoker = ((Interp *) interp)->cmdFramePtr;
-    }
-
-    /*
-     * Evaluate the script now, with FinalizeEval to do the processing after
-     * the script completes.
-     */
-
-    TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
-    return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
-}
-
-static int
-FinalizeEval(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    if (result == TCL_ERROR) {
-	Object *oPtr = data[0];
-	const char *namePtr;
-
-	if (oPtr) {
-	    namePtr = TclGetString(TclOOObjectName(interp, oPtr));
-	} else {
-	    namePtr = "my";
-	}
-
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (in \"%s eval\" script line %d)",
-		namePtr, Tcl_GetErrorLine(interp)));
-    }
-
-    /*
-     * Restore the previous "current" namespace.
-     */
-
-    TclPopStackFrame(interp);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Object_Unknown --
- *
- *	Default unknown method handler method (defined in oo::object). This
- *	just creates a suitable error message.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Object_Unknown(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    CallContext *contextPtr = (CallContext *) context;
-    Object *oPtr = contextPtr->oPtr;
-    const char **methodNames;
-    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
-
-    /*
-     * If no method name, generate an error asking for a method name. (Only by
-     * overriding *this* method can an object handle the absence of a method
-     * name without an error).
-     */
-
-    if (objc < skip+1) {
-	Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get the list of methods that we want to know about.
-     */
-
-    numMethodNames = TclOOGetSortedMethodList(oPtr,
-	    contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);
-
-    /*
-     * Special message when there are no visible methods at all.
-     */
-
-    if (numMethodNames == 0) {
-	Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr);
-
-	Tcl_AppendResult(interp, "object \"", TclGetString(tmpBuf), NULL);
-	if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
-	    Tcl_AppendResult(interp, "\" has no visible methods", NULL);
-	} else {
-	    Tcl_AppendResult(interp, "\" has no methods", NULL);
-	}
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[skip]), NULL);
-	return TCL_ERROR;
-    }
-
-    Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[skip]),
-	    "\": must be ", NULL);
-    for (i=0 ; i<numMethodNames-1 ; i++) {
-	if (i) {
-	    Tcl_AppendResult(interp, ", ", NULL);
-	}
-	Tcl_AppendResult(interp, methodNames[i], NULL);
-    }
-    if (i) {
-	Tcl_AppendResult(interp, " or ", NULL);
-    }
-    Tcl_AppendResult(interp, methodNames[i], NULL);
-    ckfree(methodNames);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-	    TclGetString(objv[skip]), NULL);
-    return TCL_ERROR;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Object_LinkVar --
- *
- *	Implementation of oo::object->variable method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Object_LinkVar(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Object object = Tcl_ObjectContextObject(context);
-    Namespace *savedNsPtr;
-    int i;
-
-    if (objc-Tcl_ObjectContextSkippedArgs(context) < 0) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"?varName ...?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * A sanity check. Shouldn't ever happen. (This is all that remains of a
-     * more complex check inherited from [global] after we have applied the
-     * fix for [Bug 2903811]; note that the fix involved *removing* code.)
-     */
-
-    if (iPtr->varFramePtr == NULL) {
-	return TCL_OK;
-    }
-
-    for (i=Tcl_ObjectContextSkippedArgs(context) ; i<objc ; i++) {
-	Var *varPtr, *aryPtr;
-	const char *varName = TclGetString(objv[i]);
-
-	/*
-	 * The variable name must not contain a '::' since that's illegal in
-	 * local names.
-	 */
-
-	if (strstr(varName, "::") != NULL) {
-	    Tcl_AppendResult(interp, "variable name \"", varName,
-		    "\" illegal: must not contain namespace separator", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Switch to the object's namespace for the duration of this call.
-	 * Like this, the variable is looked up in the namespace of the
-	 * object, and not in the namespace of the caller. Otherwise this
-	 * would only work if the caller was a method of the object itself,
-	 * which might not be true if the method was exported. This is a bit
-	 * of a hack, but the simplest way to do this (pushing a stack frame
-	 * would be horribly expensive by comparison).
-	 */
-
-	savedNsPtr = iPtr->varFramePtr->nsPtr;
-	iPtr->varFramePtr->nsPtr = (Namespace *)
-		Tcl_GetObjectNamespace(object);
-	varPtr = TclObjLookupVar(interp, objv[i], NULL, TCL_NAMESPACE_ONLY,
-		"define", 1, 0, &aryPtr);
-	iPtr->varFramePtr->nsPtr = savedNsPtr;
-
-	if (varPtr == NULL || aryPtr != NULL) {
-	    /*
-	     * Variable cannot be an element in an array. If aryPtr is not
-	     * NULL, it is an element, so throw up an error and return.
-	     */
-
-	    TclVarErrMsg(interp, varName, NULL, "define",
-		    "name refers to an element in an array");
-	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Arrange for the lifetime of the variable to be correctly managed.
-	 * This is copied out of Tcl_VariableObjCmd...
-	 */
-
-	if (!TclIsVarNamespaceVar(varPtr)) {
-	    TclSetVarNamespaceVar(varPtr);
-	}
-
-	if (TclPtrMakeUpvar(interp, varPtr, varName, 0, -1) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOO_Object_VarName --
- *
- *	Implementation of the oo::object->varname method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOO_Object_VarName(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* Interpreter in which to create the object;
-				 * also used for error reporting. */
-    Tcl_ObjectContext context,	/* The object/call context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* The actual arguments. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *aryVar;
-    Tcl_Obj *varNamePtr;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"varName");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Switch to the object's namespace for the duration of this call. Like
-     * this, the variable is looked up in the namespace of the object, and not
-     * in the namespace of the caller. Otherwise this would only work if the
-     * caller was a method of the object itself, which might not be true if
-     * the method was exported. This is a bit of a hack, but the simplest way
-     * to do this (pushing a stack frame would be horribly expensive by
-     * comparison, and is only done when we'd otherwise interfere with the
-     * global namespace).
-     */
-
-    if (iPtr->varFramePtr == NULL) {
-	Tcl_CallFrame *dummyFrame;
-
-	TclPushStackFrame(interp, &dummyFrame,
-		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),0);
-	varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
-		TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
-	TclPopStackFrame(interp);
-    } else {
-	Namespace *savedNsPtr;
-
-	savedNsPtr = iPtr->varFramePtr->nsPtr;
-	iPtr->varFramePtr->nsPtr = (Namespace *)
-		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
-	varPtr = TclObjLookupVar(interp, objv[objc-1], NULL,
-		TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to",1,1,&aryVar);
-	iPtr->varFramePtr->nsPtr = savedNsPtr;
-    }
-
-    if (varPtr == NULL) {
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE",
-		TclGetString(objv[objc-1]), NULL);
-	return TCL_ERROR;
-    }
-
-    varNamePtr = Tcl_NewObj();
-    if (aryVar != NULL) {
-	Tcl_HashEntry *hPtr;
-	Tcl_HashSearch search;
-
-	Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);
-
-	/*
-	 * WARNING! This code pokes inside the implementation of hash tables!
-	 */
-
-	hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
-		&search);
-	while (hPtr != NULL) {
-	    if (varPtr == Tcl_GetHashValue(hPtr)) {
-		Tcl_AppendToObj(varNamePtr, "(", -1);
-		Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
-		Tcl_AppendToObj(varNamePtr, ")", -1);
-		break;
-	    }
-	    hPtr = Tcl_NextHashEntry(&search);
-	}
-    } else {
-	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
-    }
-    Tcl_SetObjResult(interp, varNamePtr);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOONextObjCmd, TclOONextToObjCmd --
- *
- *	Implementation of the [next] and [nextto] commands. Note that these
- *	commands are only ever to be used inside the body of a procedure-like
- *	method.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOONextObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *framePtr = iPtr->varFramePtr;
-    Tcl_ObjectContext context;
-
-    /*
-     * Start with sanity checks on the calling context to make sure that we
-     * are invoked from a suitable method context. If so, we can safely
-     * retrieve the handle to the object call context.
-     */
-
-    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
-	Tcl_AppendResult(interp, TclGetString(objv[0]),
-		" may only be called from inside a method", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
-	return TCL_ERROR;
-    }
-    context = framePtr->clientData;
-
-    /*
-     * Invoke the (advanced) method call context in the caller context. Note
-     * that this is like [uplevel 1] and not [eval].
-     */
-
-    TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
-    iPtr->varFramePtr = framePtr->callerVarPtr;
-    return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
-}
-
-int
-TclOONextToObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *framePtr = iPtr->varFramePtr;
-    Class *classPtr;
-    CallContext *contextPtr;
-    int i;
-    Tcl_Object object;
-
-    /*
-     * Start with sanity checks on the calling context to make sure that we
-     * are invoked from a suitable method context. If so, we can safely
-     * retrieve the handle to the object call context.
-     */
-
-    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
-	Tcl_AppendResult(interp, TclGetString(objv[0]),
-		" may only be called from inside a method", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
-	return TCL_ERROR;
-    }
-    contextPtr = framePtr->clientData;
-
-    /*
-     * Sanity check the arguments; we need the first one to refer to a class.
-     */
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "class ?arg...?");
-	return TCL_ERROR;
-    }
-    object = Tcl_GetObjectFromObj(interp, objv[1]);
-    if (object == NULL) {
-	return TCL_ERROR;
-    }
-    classPtr = ((Object *)object)->classPtr;
-    if (classPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", TclGetString(objv[1]),
-		"\" is not a class", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Search for an implementation of a method associated with the current
-     * call on the call chain past the point where we currently are. Do not
-     * allow jumping backwards!
-     */
-
-    for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
-	struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
-
-	if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
-	    /*
-	     * Invoke the (advanced) method call context in the caller
-	     * context. Note that this is like [uplevel 1] and not [eval].
-	     */
-
-	    TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
-		    INT2PTR(contextPtr->index), NULL);
-	    contextPtr->index = i-1;
-	    iPtr->varFramePtr = framePtr->callerVarPtr;
-	    return TclNRObjectContextInvokeNext(interp,
-		    (Tcl_ObjectContext) contextPtr, objc, objv, 2);
-	}
-    }
-
-    /*
-     * Generate an appropriate error message, depending on whether the value
-     * is on the chain but unreachable, or not on the chain at all.
-     */
-
-    for (i=contextPtr->index ; i>=0 ; i--) {
-	struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
-
-	if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
-	    Tcl_AppendResult(interp, "method implementation by \"",
-		    TclGetString(objv[1]), "\" not reachable from here",
-		    NULL);
-	    return TCL_ERROR;
-	}
-    }
-    Tcl_AppendResult(interp, "method has no non-filter implementation by \"",
-	    TclGetString(objv[1]), "\"", NULL);
-    return TCL_ERROR;
-}
-
-static int
-RestoreFrame(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    CallContext *contextPtr = data[1];
-
-    iPtr->varFramePtr = data[0];
-    if (contextPtr != NULL) {
-	contextPtr->index = PTR2INT(data[2]);
-    }
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOSelfObjCmd --
- *
- *	Implementation of the [self] command, which provides introspection of
- *	the call context.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOSelfObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    static const char *const subcmds[] = {
-	"call", "caller", "class", "filter", "method", "namespace", "next",
-	"object", "target", NULL
-    };
-    enum SelfCmds {
-	SELF_CALL, SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS,
-	SELF_NEXT, SELF_OBJECT, SELF_TARGET
-    };
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *framePtr = iPtr->varFramePtr;
-    CallContext *contextPtr;
-    Tcl_Obj *result[3];
-    int index;
-
-#define CurrentlyInvoked(contextPtr) \
-    ((contextPtr)->callPtr->chain[(contextPtr)->index])
-
-    /*
-     * Start with sanity checks on the calling context and the method context.
-     */
-
-    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
-	Tcl_AppendResult(interp, TclGetString(objv[0]),
-		" may only be called from inside a method", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
-	return TCL_ERROR;
-    }
-
-    contextPtr = framePtr->clientData;
-
-    /*
-     * Now we do "conventional" argument parsing for a while. Note that no
-     * subcommand takes arguments.
-     */
-
-    if (objc > 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
-	return TCL_ERROR;
-    } else if (objc == 1) {
-	index = SELF_OBJECT;
-    } else if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "subcommand", 0,
-	    &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum SelfCmds) index) {
-    case SELF_OBJECT:
-	Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr));
-	return TCL_OK;
-    case SELF_NS:
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		contextPtr->oPtr->namespacePtr->fullName,-1));
-	return TCL_OK;
-    case SELF_CLASS: {
-	Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;
-
-	if (clsPtr == NULL) {
-	    Tcl_AppendResult(interp, "method not defined by a class", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
-	    return TCL_ERROR;
-	}
-
-	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
-	return TCL_OK;
-    }
-    case SELF_METHOD:
-	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
-	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName);
-	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
-	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName);
-	} else {
-	    Tcl_SetObjResult(interp,
-		    CurrentlyInvoked(contextPtr).mPtr->namePtr);
-	}
-	return TCL_OK;
-    case SELF_FILTER:
-	if (!CurrentlyInvoked(contextPtr).isFilter) {
-	    Tcl_AppendResult(interp, "not inside a filtering context", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
-	    return TCL_ERROR;
-	} else {
-	    register struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
-	    Object *oPtr;
-	    const char *type;
-
-	    if (miPtr->filterDeclarer != NULL) {
-		oPtr = miPtr->filterDeclarer->thisPtr;
-		type = "class";
-	    } else {
-		oPtr = contextPtr->oPtr;
-		type = "object";
-	    }
-
-	    result[0] = TclOOObjectName(interp, oPtr);
-	    result[1] = Tcl_NewStringObj(type, -1);
-	    result[2] = miPtr->mPtr->namePtr;
-	    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
-	    return TCL_OK;
-	}
-    case SELF_CALLER:
-	if ((framePtr->callerVarPtr == NULL) ||
-		!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
-	    Tcl_AppendResult(interp, "caller is not an object", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
-	    return TCL_ERROR;
-	} else {
-	    CallContext *callerPtr = framePtr->callerVarPtr->clientData;
-	    Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
-	    Object *declarerPtr;
-
-	    if (mPtr->declaringClassPtr != NULL) {
-		declarerPtr = mPtr->declaringClassPtr->thisPtr;
-	    } else if (mPtr->declaringObjectPtr != NULL) {
-		declarerPtr = mPtr->declaringObjectPtr;
-	    } else {
-		/*
-		 * This should be unreachable code.
-		 */
-
-		Tcl_AppendResult(interp, "method without declarer!", NULL);
-		return TCL_ERROR;
-	    }
-
-	    result[0] = TclOOObjectName(interp, declarerPtr);
-	    result[1] = TclOOObjectName(interp, callerPtr->oPtr);
-	    if (callerPtr->callPtr->flags & CONSTRUCTOR) {
-		result[2] = declarerPtr->fPtr->constructorName;
-	    } else if (callerPtr->callPtr->flags & DESTRUCTOR) {
-		result[2] = declarerPtr->fPtr->destructorName;
-	    } else {
-		result[2] = mPtr->namePtr;
-	    }
-	    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
-	    return TCL_OK;
-	}
-    case SELF_NEXT:
-	if (contextPtr->index < contextPtr->callPtr->numChain-1) {
-	    Method *mPtr =
-		    contextPtr->callPtr->chain[contextPtr->index+1].mPtr;
-	    Object *declarerPtr;
-
-	    if (mPtr->declaringClassPtr != NULL) {
-		declarerPtr = mPtr->declaringClassPtr->thisPtr;
-	    } else if (mPtr->declaringObjectPtr != NULL) {
-		declarerPtr = mPtr->declaringObjectPtr;
-	    } else {
-		/*
-		 * This should be unreachable code.
-		 */
-
-		Tcl_AppendResult(interp, "method without declarer!", NULL);
-		return TCL_ERROR;
-	    }
-
-	    result[0] = TclOOObjectName(interp, declarerPtr);
-	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
-		result[1] = declarerPtr->fPtr->constructorName;
-	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
-		result[1] = declarerPtr->fPtr->destructorName;
-	    } else {
-		result[1] = mPtr->namePtr;
-	    }
-	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
-	}
-	return TCL_OK;
-    case SELF_TARGET:
-	if (!CurrentlyInvoked(contextPtr).isFilter) {
-	    Tcl_AppendResult(interp, "not inside a filtering context", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
-	    return TCL_ERROR;
-	} else {
-	    Method *mPtr;
-	    Object *declarerPtr;
-	    int i;
-
-	    for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){
-		if (!contextPtr->callPtr->chain[i].isFilter) {
-		    break;
-		}
-	    }
-	    if (i == contextPtr->callPtr->numChain) {
-		Tcl_Panic("filtering call chain without terminal non-filter");
-	    }
-	    mPtr = contextPtr->callPtr->chain[i].mPtr;
-	    if (mPtr->declaringClassPtr != NULL) {
-		declarerPtr = mPtr->declaringClassPtr->thisPtr;
-	    } else if (mPtr->declaringObjectPtr != NULL) {
-		declarerPtr = mPtr->declaringObjectPtr;
-	    } else {
-		/*
-		 * This should be unreachable code.
-		 */
-
-		Tcl_AppendResult(interp, "method without declarer!", NULL);
-		return TCL_ERROR;
-	    }
-	    result[0] = TclOOObjectName(interp, declarerPtr);
-	    result[1] = mPtr->namePtr;
-	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
-	    return TCL_OK;
-	}
-    case SELF_CALL:
-	result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
-	result[1] = Tcl_NewIntObj(contextPtr->index);
-	Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
-	return TCL_OK;
-    }
-    return TCL_ERROR;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * CopyObjectCmd --
- *
- *	Implementation of the [oo::copy] command, which clones an object (but
- *	not its namespace). Note that no constructors are called during this
- *	process.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOCopyObjectCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Tcl_Object oPtr, o2Ptr;
-
-    if (objc < 2 || objc > 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "sourceName ?targetName?");
-	return TCL_ERROR;
-    }
-
-    oPtr = Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Create a cloned object of the correct class. Note that constructors are
-     * not called. Also note that we must resolve the object name ourselves
-     * because we do not want to create the object in the current namespace,
-     * but rather in the context of the namespace of the caller of the overall
-     * [oo::define] command.
-     */
-
-    if (objc == 2) {
-	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
-    } else {
-	const char *name;
-	Tcl_DString buffer;
-
-	name = TclGetString(objv[2]);
-	Tcl_DStringInit(&buffer);
-	if (name[0]!=':' || name[1]!=':') {
-	    Interp *iPtr = (Interp *) interp;
-
-	    if (iPtr->varFramePtr != NULL) {
-		Tcl_DStringAppend(&buffer,
-			iPtr->varFramePtr->nsPtr->fullName, -1);
-	    }
-	    Tcl_DStringAppend(&buffer, "::", 2);
-	    Tcl_DStringAppend(&buffer, name, -1);
-	    name = Tcl_DStringValue(&buffer);
-	}
-	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL);
-	Tcl_DStringFree(&buffer);
-    }
-
-    if (o2Ptr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Return the name of the cloned object.
-     */
-
-    Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) o2Ptr));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOUpcatchCmd --
- *
- *	Implementation of the [oo::UpCatch] command, which is a combination of
- *	[uplevel 1] and [catch] that makes it easier to write transparent
- *	error handling in scripts.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOUpcatchCmd(
-    ClientData ignored,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    return Tcl_NRCallObjProc(interp, TclOONRUpcatch, NULL, objc, objv);
-}
-
-static int
-UpcatchCallback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *savedFramePtr = data[0];
-    Tcl_Obj *resultObj[2];
-    int rewind = iPtr->execEnvPtr->rewind;
-
-    iPtr->varFramePtr = savedFramePtr;
-    if (rewind || Tcl_LimitExceeded(interp)) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"UpCatch\" body line %d)", Tcl_GetErrorLine(interp)));
-	return TCL_ERROR;
-    }
-    resultObj[0] = Tcl_GetObjResult(interp);
-    resultObj[1] = Tcl_GetReturnOptions(interp, result);
-    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj));
-    return TCL_OK;
-}
-
-int
-TclOONRUpcatch(
-    ClientData ignored,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *savedFramePtr = iPtr->varFramePtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "script");
-	return TCL_ERROR;
-    }
-    if (iPtr->varFramePtr->callerVarPtr != NULL) {
-	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
-    }
-
-    Tcl_NRAddCallback(interp, UpcatchCallback, savedFramePtr, NULL,NULL,NULL);
-    return TclNREvalObjEx(interp, objv[1], TCL_EVAL_NOERR,
-	    iPtr->cmdFramePtr, 1);
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
deleted file mode 100644
index 760bd7b..0000000
--- a/generic/tclOOCall.c
+++ /dev/null
@@ -1,1496 +0,0 @@
-/*
- * tclOOCall.c --
- *
- *	This file contains the method call chain management code for the
- *	object-system core.
- *
- * Copyright (c) 2005-2011 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.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "tclInt.h"
-#include "tclOOInt.h"
-
-/*
- * Structure containing a CallContext and any other values needed only during
- * the construction of the CallContext.
- */
-
-struct ChainBuilder {
-    CallChain *callChainPtr;	/* The call chain being built. */
-    int filterLength;		/* Number of entries in the call chain that
-				 * are due to processing filters and not the
-				 * main call chain. */
-    Object *oPtr;		/* The object that we are building the chain
-				 * for. */
-};
-
-/*
- * Extra flags used for call chain management.
- */
-
-#define DEFINITE_PROTECTED 0x100000
-#define DEFINITE_PUBLIC    0x200000
-#define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
-#define SPECIAL		   (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
-
-/*
- * Function declarations for things defined in this file.
- */
-
-static void		AddClassFiltersToCallContext(Object *const oPtr,
-			    Class *clsPtr, struct ChainBuilder *const cbPtr,
-			    Tcl_HashTable *const doneFilters);
-static void		AddClassMethodNames(Class *clsPtr, const int flags,
-			    Tcl_HashTable *const namesPtr);
-static inline void	AddMethodToCallChain(Method *const mPtr,
-			    struct ChainBuilder *const cbPtr,
-			    Tcl_HashTable *const doneFilters,
-			    Class *const filterDecl);
-static inline void	AddSimpleChainToCallContext(Object *const oPtr,
-			    Tcl_Obj *const methodNameObj,
-			    struct ChainBuilder *const cbPtr,
-			    Tcl_HashTable *const doneFilters, int flags,
-			    Class *const filterDecl);
-static void		AddSimpleClassChainToCallContext(Class *classPtr,
-			    Tcl_Obj *const methodNameObj,
-			    struct ChainBuilder *const cbPtr,
-			    Tcl_HashTable *const doneFilters, int flags,
-			    Class *const filterDecl);
-static int		CmpStr(const void *ptr1, const void *ptr2);
-static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
-static int		FinalizeMethodRefs(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static void		FreeMethodNameRep(Tcl_Obj *objPtr);
-static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
-			    int flags, int reuseMask);
-static int		ResetFilterFlags(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static int		SetFilterFlags(ClientData data[],
-			    Tcl_Interp *interp, int result);
-static inline void	StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
-
-/*
- * Object type used to manage type caches attached to method names.
- */
-
-static const Tcl_ObjType methodNameType = {
-    "TclOO method name",
-    FreeMethodNameRep,
-    DupMethodNameRep,
-    NULL,
-    NULL
-};
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODeleteContext --
- *
- *	Destroys a method call-chain context, which should not be in use.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOODeleteContext(
-    CallContext *contextPtr)
-{
-    register Object *oPtr = contextPtr->oPtr;
-
-    TclOODeleteChain(contextPtr->callPtr);
-    if (oPtr != NULL) {
-	TclStackFree(oPtr->fPtr->interp, contextPtr);
-	DelRef(oPtr);
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODeleteChainCache --
- *
- *	Destroy the cache of method call-chains.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOODeleteChainCache(
-    Tcl_HashTable *tablePtr)
-{
-    FOREACH_HASH_DECLS;
-    CallChain *callPtr;
-
-    FOREACH_HASH_VALUE(callPtr, tablePtr) {
-	if (callPtr) {
-	    TclOODeleteChain(callPtr);
-	}
-    }
-    Tcl_DeleteHashTable(tablePtr);
-    ckfree(tablePtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODeleteChain --
- *
- *	Destroys a method call-chain.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOODeleteChain(
-    CallChain *callPtr)
-{
-    if (--callPtr->refCount >= 1) {
-	return;
-    }
-    if (callPtr->chain != callPtr->staticChain) {
-	ckfree(callPtr->chain);
-    }
-    ckfree(callPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOStashContext --
- *
- *	Saves a reference to a method call context in a Tcl_Obj's internal
- *	representation.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline void
-StashCallChain(
-    Tcl_Obj *objPtr,
-    CallChain *callPtr)
-{
-    callPtr->refCount++;
-    TclFreeIntRep(objPtr);
-    objPtr->typePtr = &methodNameType;
-    objPtr->internalRep.otherValuePtr = callPtr;
-}
-
-void
-TclOOStashContext(
-    Tcl_Obj *objPtr,
-    CallContext *contextPtr)
-{
-    StashCallChain(objPtr, contextPtr->callPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * DupMethodNameRep, FreeMethodNameRep --
- *
- *	Functions to implement the required parts of the Tcl_Obj guts needed
- *	for caching of method contexts in Tcl_Objs.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-DupMethodNameRep(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *dstPtr)
-{
-    register CallChain *callPtr = srcPtr->internalRep.otherValuePtr;
-
-    dstPtr->typePtr = &methodNameType;
-    dstPtr->internalRep.otherValuePtr = callPtr;
-    callPtr->refCount++;
-}
-
-static void
-FreeMethodNameRep(
-    Tcl_Obj *objPtr)
-{
-    register CallChain *callPtr = objPtr->internalRep.otherValuePtr;
-
-    TclOODeleteChain(callPtr);
-    objPtr->internalRep.otherValuePtr = NULL;
-    objPtr->typePtr = NULL;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOInvokeContext --
- *
- *	Invokes a single step along a method call-chain context. Note that the
- *	invokation of a step along the chain can cause further steps along the
- *	chain to be invoked. Note that this function is written to be as light
- *	in stack usage as possible.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOInvokeContext(
-    ClientData clientData,	/* The method call context. */
-    Tcl_Interp *interp,		/* Interpreter for error reporting, and many
-				 * other sorts of context handling (e.g.,
-				 * commands, variables) depending on method
-				 * implementation. */
-    int objc,			/* The number of arguments. */
-    Tcl_Obj *const objv[])	/* The arguments as actually seen. */
-{
-    register CallContext *const contextPtr = clientData;
-    Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
-    const int isFilter =
-	    contextPtr->callPtr->chain[contextPtr->index].isFilter;
-
-    /*
-     * If this is the first step along the chain, we preserve the method
-     * entries in the chain so that they do not get deleted out from under our
-     * feet.
-     */
-
-    if (contextPtr->index == 0) {
-	int i;
-
-	for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
-	    AddRef(contextPtr->callPtr->chain[i].mPtr);
-	}
-
-	/*
-	 * Ensure that the method name itself is part of the arguments when
-	 * we're doing unknown processing.
-	 */
-
-	if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) {
-	    contextPtr->skip--;
-	}
-
-	/*
-	 * Add a callback to ensure that method references are dropped once
-	 * this call is finished.
-	 */
-
-	TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
-		NULL);
-    }
-
-    /*
-     * Save whether we were in a filter and set up whether we are now.
-     */
-
-    if (contextPtr->oPtr->flags & FILTER_HANDLING) {
-	TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
-    } else {
-	TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
-    }
-    if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
-	contextPtr->oPtr->flags |= FILTER_HANDLING;
-    } else {
-	contextPtr->oPtr->flags &= ~FILTER_HANDLING;
-    }
-
-    /*
-     * Run the method implementation.
-     */
-
-    return mPtr->typePtr->callProc(mPtr->clientData, interp,
-	    (Tcl_ObjectContext) contextPtr, objc, objv);
-}
-
-static int
-SetFilterFlags(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CallContext *contextPtr = data[0];
-
-    contextPtr->oPtr->flags |= FILTER_HANDLING;
-    return result;
-}
-
-static int
-ResetFilterFlags(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CallContext *contextPtr = data[0];
-
-    contextPtr->oPtr->flags &= ~FILTER_HANDLING;
-    return result;
-}
-
-static int
-FinalizeMethodRefs(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CallContext *contextPtr = data[0];
-    int i;
-
-    for (i=0 ; i<contextPtr->callPtr->numChain ; i++) {
-	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
-    }
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList --
- *
- *	Discovers the list of method names supported by an object or class.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOGetSortedMethodList(
-    Object *oPtr,		/* The object to get the method names for. */
-    int flags,			/* Whether we just want the public method
-				 * names. */
-    const char ***stringsPtr)	/* Where to write a pointer to the array of
-				 * strings to. */
-{
-    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
-				 * mapping. */
-    FOREACH_HASH_DECLS;
-    int i;
-    Class *mixinPtr;
-    Tcl_Obj *namePtr;
-    Method *mPtr;
-    int isWantedIn;
-    void *isWanted;
-
-    Tcl_InitObjHashTable(&names);
-
-    /*
-     * Name the bits used in the names table values.
-     */
-#define IN_LIST 1
-#define NO_IMPLEMENTATION 2
-
-    /*
-     * Process method names due to the object.
-     */
-
-    if (oPtr->methodsPtr) {
-	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
-	    int isNew;
-
-	    if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
-		continue;
-	    }
-	    hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
-	    if (isNew) {
-		isWantedIn = ((!(flags & PUBLIC_METHOD)
-			|| mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
-		isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
-		Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
-	    }
-	}
-    }
-
-    /*
-     * Process method names due to private methods on the object's class.
-     */
-
-    if (flags & PRIVATE_METHOD) {
-	FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
-	    if (mPtr->flags & PRIVATE_METHOD) {
-		int isNew;
-
-		hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
-		if (isNew) {
-		    isWantedIn = IN_LIST;
-		    if (mPtr->typePtr == NULL) {
-			isWantedIn |= NO_IMPLEMENTATION;
-		    }
-		    Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
-		} else if (mPtr->typePtr != NULL) {
-		    isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr));
-		    if (isWantedIn & NO_IMPLEMENTATION) {
-			isWantedIn &= ~NO_IMPLEMENTATION;
-			Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
-		    }
-		}
-	    }
-	}
-    }
-
-    /*
-     * Process (normal) method names from the class hierarchy and the mixin
-     * hierarchy.
-     */
-
-    AddClassMethodNames(oPtr->selfCls, flags, &names);
-    FOREACH(mixinPtr, oPtr->mixins) {
-	AddClassMethodNames(mixinPtr, flags, &names);
-    }
-
-    /*
-     * See how many (visible) method names there are. If none, we do not (and
-     * should not) try to sort the list of them.
-     */
-
-    i = 0;
-    if (names.numEntries != 0) {
-	const char **strings;
-
-	/*
-	 * We need to build the list of methods to sort. We will be using
-	 * qsort() for this, because it is very unlikely that the list will be
-	 * heavily sorted when it is long enough to matter.
-	 */
-
-	strings = ckalloc(sizeof(char *) * names.numEntries);
-	FOREACH_HASH(namePtr, isWanted, &names) {
-	    if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
-		if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
-		    continue;
-		}
-		strings[i++] = TclGetString(namePtr);
-	    }
-	}
-
-	/*
-	 * Note that 'i' may well be less than names.numEntries when we are
-	 * dealing with public method names.
-	 */
-
-	if (i > 0) {
-	    if (i > 1) {
-		qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
-	    }
-	    *stringsPtr = strings;
-	} else {
-	    ckfree(strings);
-	}
-    }
-
-    Tcl_DeleteHashTable(&names);
-    return i;
-}
-
-int
-TclOOGetSortedClassMethodList(
-    Class *clsPtr,		/* The class to get the method names for. */
-    int flags,			/* Whether we just want the public method
-				 * names. */
-    const char ***stringsPtr)	/* Where to write a pointer to the array of
-				 * strings to. */
-{
-    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
-				 * mapping. */
-    FOREACH_HASH_DECLS;
-    int i;
-    Tcl_Obj *namePtr;
-    void *isWanted;
-
-    Tcl_InitObjHashTable(&names);
-
-    /*
-     * Process method names from the class hierarchy and the mixin hierarchy.
-     */
-
-    AddClassMethodNames(clsPtr, flags, &names);
-
-    /*
-     * See how many (visible) method names there are. If none, we do not (and
-     * should not) try to sort the list of them.
-     */
-
-    i = 0;
-    if (names.numEntries != 0) {
-	const char **strings;
-
-	/*
-	 * We need to build the list of methods to sort. We will be using
-	 * qsort() for this, because it is very unlikely that the list will be
-	 * heavily sorted when it is long enough to matter.
-	 */
-
-	strings = ckalloc(sizeof(char *) * names.numEntries);
-	FOREACH_HASH(namePtr, isWanted, &names) {
-	    if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
-		if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
-		    continue;
-		}
-		strings[i++] = TclGetString(namePtr);
-	    }
-	}
-
-	/*
-	 * Note that 'i' may well be less than names.numEntries when we are
-	 * dealing with public method names.
-	 */
-
-	if (i > 0) {
-	    if (i > 1) {
-		qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
-	    }
-	    *stringsPtr = strings;
-	} else {
-	    ckfree(strings);
-	}
-    }
-
-    Tcl_DeleteHashTable(&names);
-    return i;
-}
-
-/* Comparator for GetSortedMethodList */
-static int
-CmpStr(
-    const void *ptr1,
-    const void *ptr2)
-{
-    const char **strPtr1 = (const char **) ptr1;
-    const char **strPtr2 = (const char **) ptr2;
-
-    return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * AddClassMethodNames --
- *
- *	Adds the method names defined by a class (or its superclasses) to the
- *	collection being built. The collection is built in a hash table to
- *	ensure that duplicates are excluded. Helper for GetSortedMethodList().
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-AddClassMethodNames(
-    Class *clsPtr,		/* Class to get method names from. */
-    const int flags,		/* Whether we are interested in just the
-				 * public method names. */
-    Tcl_HashTable *const namesPtr)
-				/* Reference to the hash table to put the
-				 * information in. The hash table maps the
-				 * Tcl_Obj * method name to an integral value
-				 * describing whether the method is wanted.
-				 * This ensures that public/private override
-				 * semantics are handled correctly.*/
-{
-    /*
-     * Scope all declarations so that the compiler can stand a good chance of
-     * making the recursive step highly efficient. We also hand-implement the
-     * tail-recursive case using a while loop; C compilers typically cannot do
-     * tail-recursion optimization usefully.
-     */
-
-    if (clsPtr->mixins.num != 0) {
-	Class *mixinPtr;
-	int i;
-
-	/* TODO: Beware of infinite loops! */
-	FOREACH(mixinPtr, clsPtr->mixins) {
-	    AddClassMethodNames(mixinPtr, flags, namesPtr);
-	}
-    }
-
-    while (1) {
-	FOREACH_HASH_DECLS;
-	Tcl_Obj *namePtr;
-	Method *mPtr;
-
-	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
-	    int isNew;
-
-	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
-	    if (isNew) {
-		int isWanted = (!(flags & PUBLIC_METHOD)
-			|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
-
-		Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
-	    } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
-		    && mPtr->typePtr != NULL) {
-		int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
-
-		isWanted &= ~NO_IMPLEMENTATION;
-		Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
-	    }
-	}
-
-	if (clsPtr->superclasses.num != 1) {
-	    break;
-	}
-	clsPtr = clsPtr->superclasses.list[0];
-    }
-    if (clsPtr->superclasses.num != 0) {
-	Class *superPtr;
-	int i;
-
-	FOREACH(superPtr, clsPtr->superclasses) {
-	    AddClassMethodNames(superPtr, flags, namesPtr);
-	}
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * AddSimpleChainToCallContext --
- *
- *	The core of the call-chain construction engine, this handles calling a
- *	particular method on a particular object. Note that filters and
- *	unknown handling are already handled by the logic that uses this
- *	function.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline void
-AddSimpleChainToCallContext(
-    Object *const oPtr,		/* Object to add call chain entries for. */
-    Tcl_Obj *const methodNameObj,
-				/* Name of method to add the call chain
-				 * entries for. */
-    struct ChainBuilder *const cbPtr,
-				/* Where to add the call chain entries. */
-    Tcl_HashTable *const doneFilters,
-				/* Where to record what call chain entries
-				 * have been processed. */
-    int flags,			/* What sort of call chain are we building. */
-    Class *const filterDecl)	/* The class that declared the filter. If
-				 * NULL, either the filter was declared by the
-				 * object or this isn't a filter. */
-{
-    int i;
-
-    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
-	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
-		(char *) methodNameObj);
-
-	if (hPtr != NULL) {
-	    Method *mPtr = Tcl_GetHashValue(hPtr);
-
-	    if (flags & PUBLIC_METHOD) {
-		if (!(mPtr->flags & PUBLIC_METHOD)) {
-		    return;
-		} else {
-		    flags |= DEFINITE_PUBLIC;
-		}
-	    } else {
-		flags |= DEFINITE_PROTECTED;
-	    }
-	}
-    }
-    if (!(flags & SPECIAL)) {
-	Tcl_HashEntry *hPtr;
-	Class *mixinPtr;
-
-	FOREACH(mixinPtr, oPtr->mixins) {
-	    AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
-		    doneFilters, flags, filterDecl);
-	}
-	if (oPtr->methodsPtr) {
-	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
-	    if (hPtr != NULL) {
-		AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
-			doneFilters, filterDecl);
-	    }
-	}
-    }
-    AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
-	    doneFilters, flags, filterDecl);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * AddMethodToCallChain --
- *
- *	Utility method that manages the adding of a particular method
- *	implementation to a call-chain.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline void
-AddMethodToCallChain(
-    Method *const mPtr,		/* Actual method implementation to add to call
-				 * chain (or NULL, a no-op). */
-    struct ChainBuilder *const cbPtr,
-				/* The call chain to add the method
-				 * implementation to. */
-    Tcl_HashTable *const doneFilters,
-				/* Where to record what filters have been
-				 * processed. If NULL, not processing filters.
-				 * Note that this function does not update
-				 * this hashtable. */
-    Class *const filterDecl)	/* The class that declared the filter. If
-				 * NULL, either the filter was declared by the
-				 * object or this isn't a filter. */
-{
-    register CallChain *callPtr = cbPtr->callChainPtr;
-    int i;
-
-    /*
-     * Return if this is just an entry used to record whether this is a public
-     * method. If so, there's nothing real to call and so nothing to add to
-     * the call chain.
-     */
-
-    if (mPtr == NULL || mPtr->typePtr == NULL) {
-	return;
-    }
-
-    /*
-     * Enforce real private method handling here. We will skip adding this
-     * method IF
-     *  1) we are not allowing private methods, AND
-     *  2) this is a private method, AND
-     *  3) this is a class method, AND
-     *  4) this method was not declared by the class of the current object.
-     *
-     * This does mean that only classes really handle private methods. This
-     * should be sufficient for [incr Tcl] support though.
-     */
-
-    if (!(callPtr->flags & PRIVATE_METHOD)
-	    && (mPtr->flags & PRIVATE_METHOD)
-	    && (mPtr->declaringClassPtr != NULL)
-	    && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
-	return;
-    }
-
-    /*
-     * First test whether the method is already in the call chain. Skip over
-     * any leading filters.
-     */
-
-    for (i=cbPtr->filterLength ; i<callPtr->numChain ; i++) {
-	if (callPtr->chain[i].mPtr == mPtr &&
-		callPtr->chain[i].isFilter == (doneFilters != NULL)) {
-	    /*
-	     * Call chain semantics states that methods come as *late* in the
-	     * call chain as possible. This is done by copying down the
-	     * following methods. Note that this does not change the number of
-	     * method invokations in the call chain; it just rearranges them.
-	     */
-
-	    Class *declCls = callPtr->chain[i].filterDeclarer;
-
-	    for (; i+1<callPtr->numChain ; i++) {
-		callPtr->chain[i] = callPtr->chain[i+1];
-	    }
-	    callPtr->chain[i].mPtr = mPtr;
-	    callPtr->chain[i].isFilter = (doneFilters != NULL);
-	    callPtr->chain[i].filterDeclarer = declCls;
-	    return;
-	}
-    }
-
-    /*
-     * Need to really add the method. This is made a bit more complex by the
-     * fact that we are using some "static" space initially, and only start
-     * realloc-ing if the chain gets long.
-     */
-
-    if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
-	callPtr->chain =
-		ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1));
-	memcpy(callPtr->chain, callPtr->staticChain,
-		sizeof(struct MInvoke) * callPtr->numChain);
-    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
-	callPtr->chain = ckrealloc(callPtr->chain,
-		sizeof(struct MInvoke) * (callPtr->numChain + 1));
-    }
-    callPtr->chain[i].mPtr = mPtr;
-    callPtr->chain[i].isFilter = (doneFilters != NULL);
-    callPtr->chain[i].filterDeclarer = filterDecl;
-    callPtr->numChain++;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InitCallChain --
- *	Encoding of the policy of how to set up a call chain. Doesn't populate
- *	the chain with the method implementation data.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline void
-InitCallChain(
-    CallChain *callPtr,
-    Object *oPtr,
-    int flags)
-{
-    callPtr->flags = flags &
-	    (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
-    if (oPtr->flags & USE_CLASS_CACHE) {
-	oPtr = oPtr->selfCls->thisPtr;
-	callPtr->flags |= USE_CLASS_CACHE;
-    }
-    callPtr->epoch = oPtr->fPtr->epoch;
-    callPtr->objectCreationEpoch = oPtr->creationEpoch;
-    callPtr->objectEpoch = oPtr->epoch;
-    callPtr->refCount = 1;
-    callPtr->numChain = 0;
-    callPtr->chain = callPtr->staticChain;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * IsStillValid --
- *	Calculates whether the given call chain can be used for executing a
- *	method for the given object. The condition on a chain from a cached
- *	location being reusable is:
- *	- Refers to the same object (same creation epoch), and
- *	- Still across the same class structure (same global epoch), and
- *	- Still across the same object strucutre (same local epoch), and
- *	- No public/private/filter magic leakage (same flags, modulo the fact
- *	  that a public chain will satisfy a non-public call).
- *
- * ----------------------------------------------------------------------
- */
-
-static inline int
-IsStillValid(
-    CallChain *callPtr,
-    Object *oPtr,
-    int flags,
-    int mask)
-{
-    if ((oPtr->flags & USE_CLASS_CACHE)) {
-	oPtr = oPtr->selfCls->thisPtr;
-	flags |= USE_CLASS_CACHE;
-    }
-    return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
-	    && (callPtr->epoch == oPtr->fPtr->epoch)
-	    && (callPtr->objectEpoch == oPtr->epoch)
-	    && ((callPtr->flags & mask) == (flags & mask)));
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOGetCallContext --
- *
- *	Responsible for constructing the call context, an ordered list of all
- *	method implementations to be called as part of a method invokation.
- *	This method is central to the whole operation of the OO system.
- *
- * ----------------------------------------------------------------------
- */
-
-CallContext *
-TclOOGetCallContext(
-    Object *oPtr,		/* The object to get the context for. */
-    Tcl_Obj *methodNameObj,	/* The name of the method to get the context
-				 * for. NULL when getting a constructor or
-				 * destructor chain. */
-    int flags,			/* What sort of context are we looking for.
-				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
-				 * PRIVATE_METHOD, DESTRUCTOR and
-				 * FILTER_HANDLING are useful. */
-    Tcl_Obj *cacheInThisObj)	/* What object to cache in, or NULL if it is
-				 * to be in the same object as the
-				 * methodNameObj. */
-{
-    CallContext *contextPtr;
-    CallChain *callPtr;
-    struct ChainBuilder cb;
-    int i, count, doFilters;
-    Tcl_HashEntry *hPtr;
-    Tcl_HashTable doneFilters;
-
-    if (cacheInThisObj == NULL) {
-	cacheInThisObj = methodNameObj;
-    }
-    if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
-	hPtr = NULL;
-	doFilters = 0;
-
-	/*
-	 * Check if we have a cached valid constructor or destructor.
-	 */
-
-	if (flags & CONSTRUCTOR) {
-	    callPtr = oPtr->selfCls->constructorChainPtr;
-	    if ((callPtr != NULL)
-		    && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
-		    && (callPtr->epoch == oPtr->fPtr->epoch)) {
-		callPtr->refCount++;
-		goto returnContext;
-	    }
-	} else if (flags & DESTRUCTOR) {
-	    callPtr = oPtr->selfCls->destructorChainPtr;
-	    if ((oPtr->mixins.num == 0) && (callPtr != NULL)
-		    && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
-		    && (callPtr->epoch == oPtr->fPtr->epoch)) {
-		callPtr->refCount++;
-		goto returnContext;
-	    }
-	}
-    } else {
-	/*
-	 * Check if we can get the chain out of the Tcl_Obj method name or out
-	 * of the cache. This is made a bit more complex by the fact that
-	 * there are multiple different layers of cache (in the Tcl_Obj, in
-	 * the object, and in the class).
-	 */
-
-	const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
-
-	if (cacheInThisObj->typePtr == &methodNameType) {
-	    callPtr = cacheInThisObj->internalRep.otherValuePtr;
-	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
-		callPtr->refCount++;
-		goto returnContext;
-	    }
-	    FreeMethodNameRep(cacheInThisObj);
-	}
-
-	if (oPtr->flags & USE_CLASS_CACHE) {
-	    if (oPtr->selfCls->classChainCache != NULL) {
-		hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
-			(char *) methodNameObj);
-	    } else {
-		hPtr = NULL;
-	    }
-	} else {
-	    if (oPtr->chainCache != NULL) {
-		hPtr = Tcl_FindHashEntry(oPtr->chainCache,
-			(char *) methodNameObj);
-	    } else {
-		hPtr = NULL;
-	    }
-	}
-
-	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
-	    callPtr = Tcl_GetHashValue(hPtr);
-	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
-		callPtr->refCount++;
-		goto returnContext;
-	    }
-	    Tcl_SetHashValue(hPtr, NULL);
-	    TclOODeleteChain(callPtr);
-	}
-
-	doFilters = 1;
-    }
-
-    callPtr = ckalloc(sizeof(CallChain));
-    InitCallChain(callPtr, oPtr, flags);
-
-    cb.callChainPtr = callPtr;
-    cb.filterLength = 0;
-    cb.oPtr = oPtr;
-
-    /*
-     * If we're working with a forced use of unknown, do that now.
-     */
-
-    if (flags & FORCE_UNKNOWN) {
-	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
-		&cb, NULL, 0, NULL);
-	callPtr->flags |= OO_UNKNOWN_METHOD;
-	callPtr->epoch = -1;
-	if (callPtr->numChain == 0) {
-	    TclOODeleteChain(callPtr);
-	    return NULL;
-	}
-	goto returnContext;
-    }
-
-    /*
-     * Add all defined filters (if any, and if we're going to be processing
-     * them; they're not processed for constructors, destructors or when we're
-     * in the middle of processing a filter).
-     */
-
-    if (doFilters) {
-	Tcl_Obj *filterObj;
-	Class *mixinPtr;
-
-	doFilters = 1;
-	Tcl_InitObjHashTable(&doneFilters);
-	FOREACH(mixinPtr, oPtr->mixins) {
-	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters);
-	}
-	FOREACH(filterObj, oPtr->filters) {
-	    AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
-		    NULL);
-	}
-	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters);
-	Tcl_DeleteHashTable(&doneFilters);
-    }
-    count = cb.filterLength = callPtr->numChain;
-
-    /*
-     * Add the actual method implementations.
-     */
-
-    AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
-
-    /*
-     * Check to see if the method has no implementation. If so, we probably
-     * need to add in a call to the unknown method. Otherwise, set up the
-     * cacheing of the method implementation (if relevant).
-     */
-
-    if (count == callPtr->numChain) {
-	/*
-	 * Method does not actually exist. If we're dealing with constructors
-	 * or destructors, this isn't a problem.
-	 */
-
-	if (flags & SPECIAL) {
-	    TclOODeleteChain(callPtr);
-	    return NULL;
-	}
-	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
-		&cb, NULL, 0, NULL);
-	callPtr->flags |= OO_UNKNOWN_METHOD;
-	callPtr->epoch = -1;
-	if (count == callPtr->numChain) {
-	    TclOODeleteChain(callPtr);
-	    return NULL;
-	}
-    } else if (doFilters) {
-	if (hPtr == NULL) {
-	    if (oPtr->flags & USE_CLASS_CACHE) {
-		if (oPtr->selfCls->classChainCache == NULL) {
-		    oPtr->selfCls->classChainCache =
-			    ckalloc(sizeof(Tcl_HashTable));
-
-		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
-		}
-		hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
-			(char *) methodNameObj, &i);
-	    } else {
-		if (oPtr->chainCache == NULL) {
-		    oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable));
-
-		    Tcl_InitObjHashTable(oPtr->chainCache);
-		}
-		hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
-			(char *) methodNameObj, &i);
-	    }
-	}
-	callPtr->refCount++;
-	Tcl_SetHashValue(hPtr, callPtr);
-	StashCallChain(cacheInThisObj, callPtr);
-    } else if (flags & CONSTRUCTOR) {
-	if (oPtr->selfCls->constructorChainPtr) {
-	    TclOODeleteChain(oPtr->selfCls->constructorChainPtr);
-	}
-	oPtr->selfCls->constructorChainPtr = callPtr;
-	callPtr->refCount++;
-    } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) {
-	if (oPtr->selfCls->destructorChainPtr) {
-	    TclOODeleteChain(oPtr->selfCls->destructorChainPtr);
-	}
-	oPtr->selfCls->destructorChainPtr = callPtr;
-	callPtr->refCount++;
-    }
-
-  returnContext:
-    contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
-    contextPtr->oPtr = oPtr;
-    AddRef(oPtr);
-    contextPtr->callPtr = callPtr;
-    contextPtr->skip = 2;
-    contextPtr->index = 0;
-    return contextPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOGetStereotypeCallChain --
- *
- *	Construct a call-chain for a method that would be used by a
- *	stereotypical instance of the given class (i.e., where the object has
- *	no definitions special to itself).
- *
- * ----------------------------------------------------------------------
- */
-
-CallChain *
-TclOOGetStereotypeCallChain(
-    Class *clsPtr,		/* The object to get the context for. */
-    Tcl_Obj *methodNameObj,	/* The name of the method to get the context
-				 * for. NULL when getting a constructor or
-				 * destructor chain. */
-    int flags)			/* What sort of context are we looking for.
-				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
-				 * PRIVATE_METHOD, DESTRUCTOR and
-				 * FILTER_HANDLING are useful. */
-{
-    CallChain *callPtr;
-    struct ChainBuilder cb;
-    int i, count;
-    Foundation *fPtr = clsPtr->thisPtr->fPtr;
-    Tcl_HashEntry *hPtr;
-    Tcl_HashTable doneFilters;
-    Object obj;
-
-    /*
-     * Synthesize a temporary stereotypical object so that we can use existing
-     * machinery to produce the stereotypical call chain.
-     */
-
-    memset(&obj, 0, sizeof(Object));
-    obj.fPtr = fPtr;
-    obj.selfCls = clsPtr;
-    obj.refCount = 1;
-    obj.flags = USE_CLASS_CACHE;
-
-    /*
-     * Check if we can get the chain out of the Tcl_Obj method name or out of
-     * the cache. This is made a bit more complex by the fact that there are
-     * multiple different layers of cache (in the Tcl_Obj, in the object, and
-     * in the class).
-     */
-
-    if (clsPtr->classChainCache != NULL) {
-	hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
-		(char *) methodNameObj);
-	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
-	    const int reuseMask =
-		    ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
-
-	    callPtr = Tcl_GetHashValue(hPtr);
-	    if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
-		callPtr->refCount++;
-		return callPtr;
-	    }
-	    Tcl_SetHashValue(hPtr, NULL);
-	    TclOODeleteChain(callPtr);
-	}
-    } else {
-	hPtr = NULL;
-    }
-
-    callPtr = ckalloc(sizeof(CallChain));
-    memset(callPtr, 0, sizeof(CallChain));
-    callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
-    callPtr->epoch = fPtr->epoch;
-    callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
-    callPtr->objectEpoch = clsPtr->thisPtr->epoch;
-    callPtr->refCount = 1;
-    callPtr->chain = callPtr->staticChain;
-
-    cb.callChainPtr = callPtr;
-    cb.filterLength = 0;
-    cb.oPtr = &obj;
-
-    /*
-     * Add all defined filters (if any, and if we're going to be processing
-     * them; they're not processed for constructors, destructors or when we're
-     * in the middle of processing a filter).
-     */
-
-    Tcl_InitObjHashTable(&doneFilters);
-    AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters);
-    Tcl_DeleteHashTable(&doneFilters);
-    count = cb.filterLength = callPtr->numChain;
-
-    /*
-     * Add the actual method implementations.
-     */
-
-    AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
-
-    /*
-     * Check to see if the method has no implementation. If so, we probably
-     * need to add in a call to the unknown method. Otherwise, set up the
-     * cacheing of the method implementation (if relevant).
-     */
-
-    if (count == callPtr->numChain) {
-	AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
-		NULL, 0, NULL);
-	callPtr->flags |= OO_UNKNOWN_METHOD;
-	callPtr->epoch = -1;
-	if (count == callPtr->numChain) {
-	    TclOODeleteChain(callPtr);
-	    return NULL;
-	}
-    } else {
-	if (hPtr == NULL) {
-	    if (clsPtr->classChainCache == NULL) {
-		clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable));
-		Tcl_InitObjHashTable(clsPtr->classChainCache);
-	    }
-	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
-		    (char *) methodNameObj, &i);
-	}
-	callPtr->refCount++;
-	Tcl_SetHashValue(hPtr, callPtr);
-	StashCallChain(methodNameObj, callPtr);
-    }
-    return callPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * AddClassFiltersToCallContext --
- *
- *	Logic to make extracting all the filters from the class context much
- *	easier.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-AddClassFiltersToCallContext(
-    Object *const oPtr,		/* Object that the filters operate on. */
-    Class *clsPtr,		/* Class to get the filters from. */
-    struct ChainBuilder *const cbPtr,
-				/* Context to fill with call chain entries. */
-    Tcl_HashTable *const doneFilters)
-				/* Where to record what filters have been
-				 * processed. Keys are objects, values are
-				 * ignored. */
-{
-    int i;
-    Class *superPtr, *mixinPtr;
-    Tcl_Obj *filterObj;
-
-  tailRecurse:
-    if (clsPtr == NULL) {
-	return;
-    }
-
-    /*
-     * Add all the filters defined by classes mixed into the main class
-     * hierarchy.
-     */
-
-    FOREACH(mixinPtr, clsPtr->mixins) {
-	AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters);
-    }
-
-    /*
-     * Add all the class filters from the current class. Note that the filters
-     * are added starting at the object root, as this allows the object to
-     * override how filters work to extend their behaviour.
-     */
-
-    FOREACH(filterObj, clsPtr->filters) {
-	int isNew;
-
-	(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew);
-	if (isNew) {
-	    AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters,
-		    0, clsPtr);
-	}
-    }
-
-    /*
-     * Now process the recursive case. Notice the tail-call optimization.
-     */
-
-    switch (clsPtr->superclasses.num) {
-    case 1:
-	clsPtr = clsPtr->superclasses.list[0];
-	goto tailRecurse;
-    default:
-	FOREACH(superPtr, clsPtr->superclasses) {
-	    AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters);
-	}
-    case 0:
-	return;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * AddSimpleClassChainToCallContext --
- *
- *	Construct a call-chain from a class hierarchy.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-AddSimpleClassChainToCallContext(
-    Class *classPtr,		/* Class to add the call chain entries for. */
-    Tcl_Obj *const methodNameObj,
-				/* Name of method to add the call chain
-				 * entries for. */
-    struct ChainBuilder *const cbPtr,
-				/* Where to add the call chain entries. */
-    Tcl_HashTable *const doneFilters,
-				/* Where to record what call chain entries
-				 * have been processed. */
-    int flags,			/* What sort of call chain are we building. */
-    Class *const filterDecl)	/* The class that declared the filter. If
-				 * NULL, either the filter was declared by the
-				 * object or this isn't a filter. */
-{
-    int i;
-    Class *superPtr;
-
-    /*
-     * We hard-code the tail-recursive form. It's by far the most common case
-     * *and* it is much more gentle on the stack.
-     *
-     * Note that mixins must be processed before the main class hierarchy.
-     * [Bug 1998221]
-     */
-
-  tailRecurse:
-    FOREACH(superPtr, classPtr->mixins) {
-	AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
-		doneFilters, flags, filterDecl);
-    }
-
-    if (flags & CONSTRUCTOR) {
-	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
-		filterDecl);
-
-    } else if (flags & DESTRUCTOR) {
-	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
-		filterDecl);
-    } else {
-	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
-		(char *) methodNameObj);
-
-	if (hPtr != NULL) {
-	    register Method *mPtr = Tcl_GetHashValue(hPtr);
-
-	    if (!(flags & KNOWN_STATE)) {
-		if (flags & PUBLIC_METHOD) {
-		    if (mPtr->flags & PUBLIC_METHOD) {
-			flags |= DEFINITE_PUBLIC;
-		    } else {
-			return;
-		    }
-		} else {
-		    flags |= DEFINITE_PROTECTED;
-		}
-	    }
-	    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl);
-	}
-    }
-
-    switch (classPtr->superclasses.num) {
-    case 1:
-	classPtr = classPtr->superclasses.list[0];
-	goto tailRecurse;
-    default:
-	FOREACH(superPtr, classPtr->superclasses) {
-	    AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
-		    doneFilters, flags, filterDecl);
-	}
-    case 0:
-	return;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOORenderCallChain --
- *
- *	Create a description of a call chain. Used in [info object call],
- *	[info class call], and [self call].
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclOORenderCallChain(
-    Tcl_Interp *interp,
-    CallChain *callPtr)
-{
-    Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral;
-    Tcl_Obj *resultObj, *descObjs[4], **objv;
-    Foundation *fPtr = TclOOGetFoundation(interp);
-    int i;
-
-    /*
-     * Allocate the literals (potentially) used in our description.
-     */
-
-    filterLiteral = Tcl_NewStringObj("filter", -1);
-    Tcl_IncrRefCount(filterLiteral);
-    methodLiteral = Tcl_NewStringObj("method", -1);
-    Tcl_IncrRefCount(methodLiteral);
-    objectLiteral = Tcl_NewStringObj("object", -1);
-    Tcl_IncrRefCount(objectLiteral);
-
-    /*
-     * Do the actual construction of the descriptions. They consist of a list
-     * of triples that describe the details of how a method is understood. For
-     * each triple, the first word is the type of invokation ("method" is
-     * normal, "unknown" is special because it adds the method name as an
-     * extra argument when handled by some method types, and "filter" is
-     * special because it's a filter method). The second word is the name of
-     * the method in question (which differs for "unknown" and "filter" types)
-     * and the third word is the full name of the class that declares the
-     * method (or "object" if it is declared on the instance).
-     */
-
-    objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
-    for (i=0 ; i<callPtr->numChain ; i++) {
-	struct MInvoke *miPtr = &callPtr->chain[i];
-
-	descObjs[0] = miPtr->isFilter
-		? filterLiteral
-		: callPtr->flags & OO_UNKNOWN_METHOD
-			? fPtr->unknownMethodNameObj
-			: methodLiteral;
-	descObjs[1] = callPtr->flags & CONSTRUCTOR
-		? fPtr->constructorName
-		: callPtr->flags & DESTRUCTOR
-			? fPtr->destructorName
-			: miPtr->mPtr->namePtr;
-	descObjs[2] = miPtr->mPtr->declaringClassPtr
-		? Tcl_GetObjectName(interp,
-			(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
-		: objectLiteral;
-	descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1);
-
-	objv[i] = Tcl_NewListObj(4, descObjs);
-    }
-
-    /*
-     * Drop the local references to the literals; if they're actually used,
-     * they'll live on the description itself.
-     */
-
-    Tcl_DecrRefCount(filterLiteral);
-    Tcl_DecrRefCount(methodLiteral);
-    Tcl_DecrRefCount(objectLiteral);
-
-    /*
-     * Finish building the description and return it.
-     */
-
-    resultObj = Tcl_NewListObj(callPtr->numChain, objv);
-    TclStackFree(interp, objv);
-    return resultObj;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
deleted file mode 100644
index 6316303..0000000
--- a/generic/tclOODecls.h
+++ /dev/null
@@ -1,218 +0,0 @@
-/*
- * This file is (mostly) automatically generated from tclOO.decls.
- */
-
-#ifndef _TCLOODECLS
-#define _TCLOODECLS
-
-/* !BEGIN!: Do not edit below this line. */
-
-/*
- * Exported function declarations:
- */
-
-/* 0 */
-TCLOOAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
-				Tcl_Object sourceObject,
-				const char *targetName,
-				const char *targetNamespaceName);
-/* 1 */
-TCLOOAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
-/* 2 */
-TCLOOAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
-/* 3 */
-TCLOOAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
-/* 4 */
-TCLOOAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr);
-/* 5 */
-TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
-/* 6 */
-TCLOOAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
-/* 7 */
-TCLOOAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
-/* 8 */
-TCLOOAPI int		Tcl_MethodIsPublic(Tcl_Method method);
-/* 9 */
-TCLOOAPI int		Tcl_MethodIsType(Tcl_Method method,
-				const Tcl_MethodType *typePtr,
-				ClientData *clientDataPtr);
-/* 10 */
-TCLOOAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
-/* 11 */
-TCLOOAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
-				Tcl_Object object, Tcl_Obj *nameObj,
-				int isPublic, const Tcl_MethodType *typePtr,
-				ClientData clientData);
-/* 12 */
-TCLOOAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
-				Tcl_Obj *nameObj, int isPublic,
-				const Tcl_MethodType *typePtr,
-				ClientData clientData);
-/* 13 */
-TCLOOAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
-				Tcl_Class cls, const char *nameStr,
-				const char *nsNameStr, int objc,
-				Tcl_Obj *const *objv, int skip);
-/* 14 */
-TCLOOAPI int		Tcl_ObjectDeleted(Tcl_Object object);
-/* 15 */
-TCLOOAPI int		Tcl_ObjectContextIsFiltering(
-				Tcl_ObjectContext context);
-/* 16 */
-TCLOOAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
-/* 17 */
-TCLOOAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
-/* 18 */
-TCLOOAPI int		Tcl_ObjectContextSkippedArgs(
-				Tcl_ObjectContext context);
-/* 19 */
-TCLOOAPI ClientData	Tcl_ClassGetMetadata(Tcl_Class clazz,
-				const Tcl_ObjectMetadataType *typePtr);
-/* 20 */
-TCLOOAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
-				const Tcl_ObjectMetadataType *typePtr,
-				ClientData metadata);
-/* 21 */
-TCLOOAPI ClientData	Tcl_ObjectGetMetadata(Tcl_Object object,
-				const Tcl_ObjectMetadataType *typePtr);
-/* 22 */
-TCLOOAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
-				const Tcl_ObjectMetadataType *typePtr,
-				ClientData metadata);
-/* 23 */
-TCLOOAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
-				Tcl_ObjectContext context, int objc,
-				Tcl_Obj *const *objv, int skip);
-/* 24 */
-TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
-				Tcl_Object object);
-/* 25 */
-TCLOOAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
-				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
-/* 26 */
-TCLOOAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
-				Tcl_Class clazz, Tcl_Method method);
-/* 27 */
-TCLOOAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
-				Tcl_Class clazz, Tcl_Method method);
-/* 28 */
-TCLOOAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
-				Tcl_Object object);
-
-typedef struct TclOOStubHooks {
-    const struct TclOOIntStubs *tclOOIntStubs;
-} TclOOStubHooks;
-
-typedef struct TclOOStubs {
-    int magic;
-    const struct TclOOStubHooks *hooks;
-
-    Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */
-    Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */
-    Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
-    Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
-    Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */
-    Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
-    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
-    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
-    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
-    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
-    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
-    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
-    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
-    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
-    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
-    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
-    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
-    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
-    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
-    ClientData (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
-    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 20 */
-    ClientData (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
-    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 22 */
-    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
-    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
-    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
-    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
-    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
-    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
-} TclOOStubs;
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern const TclOOStubs *tclOOStubsPtr;
-#ifdef __cplusplus
-}
-#endif
-
-#if defined(USE_TCLOO_STUBS)
-
-/*
- * Inline function declarations:
- */
-
-#define Tcl_CopyObjectInstance \
-	(tclOOStubsPtr->tcl_CopyObjectInstance) /* 0 */
-#define Tcl_GetClassAsObject \
-	(tclOOStubsPtr->tcl_GetClassAsObject) /* 1 */
-#define Tcl_GetObjectAsClass \
-	(tclOOStubsPtr->tcl_GetObjectAsClass) /* 2 */
-#define Tcl_GetObjectCommand \
-	(tclOOStubsPtr->tcl_GetObjectCommand) /* 3 */
-#define Tcl_GetObjectFromObj \
-	(tclOOStubsPtr->tcl_GetObjectFromObj) /* 4 */
-#define Tcl_GetObjectNamespace \
-	(tclOOStubsPtr->tcl_GetObjectNamespace) /* 5 */
-#define Tcl_MethodDeclarerClass \
-	(tclOOStubsPtr->tcl_MethodDeclarerClass) /* 6 */
-#define Tcl_MethodDeclarerObject \
-	(tclOOStubsPtr->tcl_MethodDeclarerObject) /* 7 */
-#define Tcl_MethodIsPublic \
-	(tclOOStubsPtr->tcl_MethodIsPublic) /* 8 */
-#define Tcl_MethodIsType \
-	(tclOOStubsPtr->tcl_MethodIsType) /* 9 */
-#define Tcl_MethodName \
-	(tclOOStubsPtr->tcl_MethodName) /* 10 */
-#define Tcl_NewInstanceMethod \
-	(tclOOStubsPtr->tcl_NewInstanceMethod) /* 11 */
-#define Tcl_NewMethod \
-	(tclOOStubsPtr->tcl_NewMethod) /* 12 */
-#define Tcl_NewObjectInstance \
-	(tclOOStubsPtr->tcl_NewObjectInstance) /* 13 */
-#define Tcl_ObjectDeleted \
-	(tclOOStubsPtr->tcl_ObjectDeleted) /* 14 */
-#define Tcl_ObjectContextIsFiltering \
-	(tclOOStubsPtr->tcl_ObjectContextIsFiltering) /* 15 */
-#define Tcl_ObjectContextMethod \
-	(tclOOStubsPtr->tcl_ObjectContextMethod) /* 16 */
-#define Tcl_ObjectContextObject \
-	(tclOOStubsPtr->tcl_ObjectContextObject) /* 17 */
-#define Tcl_ObjectContextSkippedArgs \
-	(tclOOStubsPtr->tcl_ObjectContextSkippedArgs) /* 18 */
-#define Tcl_ClassGetMetadata \
-	(tclOOStubsPtr->tcl_ClassGetMetadata) /* 19 */
-#define Tcl_ClassSetMetadata \
-	(tclOOStubsPtr->tcl_ClassSetMetadata) /* 20 */
-#define Tcl_ObjectGetMetadata \
-	(tclOOStubsPtr->tcl_ObjectGetMetadata) /* 21 */
-#define Tcl_ObjectSetMetadata \
-	(tclOOStubsPtr->tcl_ObjectSetMetadata) /* 22 */
-#define Tcl_ObjectContextInvokeNext \
-	(tclOOStubsPtr->tcl_ObjectContextInvokeNext) /* 23 */
-#define Tcl_ObjectGetMethodNameMapper \
-	(tclOOStubsPtr->tcl_ObjectGetMethodNameMapper) /* 24 */
-#define Tcl_ObjectSetMethodNameMapper \
-	(tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */
-#define Tcl_ClassSetConstructor \
-	(tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */
-#define Tcl_ClassSetDestructor \
-	(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
-#define Tcl_GetObjectName \
-	(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
-
-#endif /* defined(USE_TCLOO_STUBS) */
-
-/* !END!: Do not edit above this line. */
-#endif /* _TCLOODECLS */
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
deleted file mode 100644
index 3d72690..0000000
--- a/generic/tclOODefineCmds.c
+++ /dev/null
@@ -1,2621 +0,0 @@
-/*
- * tclOODefineCmds.c --
- *
- *	This file contains the implementation of the ::oo::define command,
- *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
- *
- * Copyright (c) 2006-2008 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.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "tclInt.h"
-#include "tclOOInt.h"
-
-/*
- * Some things that make it easier to declare a slot.
- */
-
-struct DeclaredSlot {
-    const char *name;
-    const Tcl_MethodType getterType;
-    const Tcl_MethodType setterType;
-};
-
-#define SLOT(name,getter,setter)					\
-    {"::oo::" name,							\
-	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
-		    getter, NULL, NULL},				\
-	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
-		    setter, NULL, NULL}}
-
-/*
- * Forward declarations.
- */
-
-static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
-static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
-			    Tcl_Namespace *const namespacePtr);
-static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
-			    Tcl_Obj *className, const char *errMsg);
-static inline int	InitDefineContext(Tcl_Interp *interp,
-			    Tcl_Namespace *namespacePtr, Object *oPtr,
-			    int objc, Tcl_Obj *const objv[]);
-static inline void	RecomputeClassCacheFlag(Object *oPtr);
-static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
-			    int useClass, Tcl_Obj *const fromPtr,
-			    Tcl_Obj *const toPtr);
-static int		ClassFilterGet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ClassFilterSet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ClassMixinGet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ClassMixinSet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ClassSuperGet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ClassSuperSet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ClassVarsGet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ClassVarsSet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ObjFilterGet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ObjFilterSet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ObjMixinGet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ObjMixinSet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ObjVarsGet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		ObjVarsSet(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-
-/*
- * Now define the slots used in declarations.
- */
-
-static const struct DeclaredSlot slots[] = {
-    SLOT("define::filter",      ClassFilterGet, ClassFilterSet),
-    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet),
-    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet),
-    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet),
-    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet),
-    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet),
-    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet),
-    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
-};
-
-/*
- * ----------------------------------------------------------------------
- *
- * BumpGlobalEpoch --
- *	Utility that ensures that call chains that are invalid will get thrown
- *	away at an appropriate time. Note that exactly which epoch gets
- *	advanced will depend on exactly what the class is tangled up in; in
- *	the worst case, the simplest option is to advance the global epoch,
- *	causing *everything* to be thrown away on next usage.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline void
-BumpGlobalEpoch(
-    Tcl_Interp *interp,
-    Class *classPtr)
-{
-    if (classPtr != NULL
-	    && classPtr->subclasses.num == 0
-	    && classPtr->instances.num == 0
-	    && classPtr->mixinSubs.num == 0) {
-	/*
-	 * If a class has no subclasses or instances, and is not mixed into
-	 * anything, a change to its structure does not require us to
-	 * invalidate any call chains. Note that we still bump our object's
-	 * epoch if it has any mixins; the relation between a class and its
-	 * representative object is special. But it won't hurt.
-	 */
-
-	if (classPtr->thisPtr->mixins.num > 0) {
-	    classPtr->thisPtr->epoch++;
-	}
-	return;
-    }
-
-    /*
-     * Either there's no class (?!) or we're reconfiguring something that is
-     * in use. Force regeneration of call chains.
-     */
-
-    TclOOGetFoundation(interp)->epoch++;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * RecomputeClassCacheFlag --
- *	Determine whether the object is prototypical of its class, and hence
- *	able to use the class's method chain cache.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline void
-RecomputeClassCacheFlag(
-    Object *oPtr)
-{
-    if ((oPtr->methodsPtr == NULL || oPtr->methodsPtr->numEntries == 0)
-	    && (oPtr->mixins.num == 0) && (oPtr->filters.num == 0)) {
-	oPtr->flags |= USE_CLASS_CACHE;
-    } else {
-	oPtr->flags &= ~USE_CLASS_CACHE;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOObjectSetFilters --
- *	Install a list of filter method names into an object.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOObjectSetFilters(
-    Object *oPtr,
-    int numFilters,
-    Tcl_Obj *const *filters)
-{
-    int i;
-
-    if (oPtr->filters.num) {
-	Tcl_Obj *filterObj;
-
-	FOREACH(filterObj, oPtr->filters) {
-	    Tcl_DecrRefCount(filterObj);
-	}
-    }
-
-    if (numFilters == 0) {
-	/*
-	 * No list of filters was supplied, so we're deleting filters.
-	 */
-
-	ckfree(oPtr->filters.list);
-	oPtr->filters.list = NULL;
-	oPtr->filters.num = 0;
-	RecomputeClassCacheFlag(oPtr);
-    } else {
-	/*
-	 * We've got a list of filters, so we're creating filters.
-	 */
-
-	Tcl_Obj **filtersList;
-	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */
-
-	if (oPtr->filters.num == 0) {
-	    filtersList = ckalloc(size);
-	} else {
-	    filtersList = ckrealloc(oPtr->filters.list, size);
-	}
-	for (i=0 ; i<numFilters ; i++) {
-	    filtersList[i] = filters[i];
-	    Tcl_IncrRefCount(filters[i]);
-	}
-	oPtr->filters.list = filtersList;
-	oPtr->filters.num = numFilters;
-	oPtr->flags &= ~USE_CLASS_CACHE;
-    }
-    oPtr->epoch++;		/* Only this object can be affected. */
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOClassSetFilters --
- *	Install a list of filter method names into a class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOClassSetFilters(
-    Tcl_Interp *interp,
-    Class *classPtr,
-    int numFilters,
-    Tcl_Obj *const *filters)
-{
-    int i;
-
-    if (classPtr->filters.num) {
-	Tcl_Obj *filterObj;
-
-	FOREACH(filterObj, classPtr->filters) {
-	    Tcl_DecrRefCount(filterObj);
-	}
-    }
-
-    if (numFilters == 0) {
-	/*
-	 * No list of filters was supplied, so we're deleting filters.
-	 */
-
-	ckfree(classPtr->filters.list);
-	classPtr->filters.list = NULL;
-	classPtr->filters.num = 0;
-    } else {
-	/*
-	 * We've got a list of filters, so we're creating filters.
-	 */
-
-	Tcl_Obj **filtersList;
-	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */
-
-	if (classPtr->filters.num == 0) {
-	    filtersList = ckalloc(size);
-	} else {
-	    filtersList = ckrealloc(classPtr->filters.list, size);
-	}
-	for (i=0 ; i<numFilters ; i++) {
-	    filtersList[i] = filters[i];
-	    Tcl_IncrRefCount(filters[i]);
-	}
-	classPtr->filters.list = filtersList;
-	classPtr->filters.num = numFilters;
-    }
-
-    /*
-     * There may be many objects affected, so bump the global epoch.
-     */
-
-    BumpGlobalEpoch(interp, classPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOObjectSetMixins --
- *	Install a list of mixin classes into an object.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOObjectSetMixins(
-    Object *oPtr,
-    int numMixins,
-    Class *const *mixins)
-{
-    Class *mixinPtr;
-    int i;
-
-    if (numMixins == 0) {
-	if (oPtr->mixins.num != 0) {
-	    FOREACH(mixinPtr, oPtr->mixins) {
-		TclOORemoveFromInstances(oPtr, mixinPtr);
-	    }
-	    ckfree(oPtr->mixins.list);
-	    oPtr->mixins.num = 0;
-	}
-	RecomputeClassCacheFlag(oPtr);
-    } else {
-	if (oPtr->mixins.num != 0) {
-	    FOREACH(mixinPtr, oPtr->mixins) {
-		if (mixinPtr != oPtr->selfCls) {
-		    TclOORemoveFromInstances(oPtr, mixinPtr);
-		}
-	    }
-	    oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
-		    sizeof(Class *) * numMixins);
-	} else {
-	    oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
-	    oPtr->flags &= ~USE_CLASS_CACHE;
-	}
-	oPtr->mixins.num = numMixins;
-	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
-	FOREACH(mixinPtr, oPtr->mixins) {
-	    if (mixinPtr != oPtr->selfCls) {
-		TclOOAddToInstances(oPtr, mixinPtr);
-	    }
-	}
-    }
-    oPtr->epoch++;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOClassSetMixins --
- *	Install a list of mixin classes into a class.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOClassSetMixins(
-    Tcl_Interp *interp,
-    Class *classPtr,
-    int numMixins,
-    Class *const *mixins)
-{
-    Class *mixinPtr;
-    int i;
-
-    if (numMixins == 0) {
-	if (classPtr->mixins.num != 0) {
-	    FOREACH(mixinPtr, classPtr->mixins) {
-		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
-	    }
-	    ckfree(classPtr->mixins.list);
-	    classPtr->mixins.num = 0;
-	}
-    } else {
-	if (classPtr->mixins.num != 0) {
-	    FOREACH(mixinPtr, classPtr->mixins) {
-		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
-	    }
-	    classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
-		    sizeof(Class *) * numMixins);
-	} else {
-	    classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
-	}
-	classPtr->mixins.num = numMixins;
-	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
-	FOREACH(mixinPtr, classPtr->mixins) {
-	    TclOOAddToMixinSubs(classPtr, mixinPtr);
-	}
-    }
-    BumpGlobalEpoch(interp, classPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * RenameDeleteMethod --
- *	Core of the code to rename and delete methods.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-RenameDeleteMethod(
-    Tcl_Interp *interp,
-    Object *oPtr,
-    int useClass,
-    Tcl_Obj *const fromPtr,
-    Tcl_Obj *const toPtr)
-{
-    Tcl_HashEntry *hPtr, *newHPtr = NULL;
-    Method *mPtr;
-    int isNew;
-
-    if (!useClass) {
-	if (!oPtr->methodsPtr) {
-	noSuchMethod:
-	    Tcl_AppendResult(interp, "method ", TclGetString(fromPtr),
-		    " does not exist", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		    TclGetString(fromPtr), NULL);
-	    return TCL_ERROR;
-	}
-	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr);
-	if (hPtr == NULL) {
-	    goto noSuchMethod;
-	}
-	if (toPtr) {
-	    newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) toPtr,
-		    &isNew);
-	    if (hPtr == newHPtr) {
-	    renameToSelf:
-		Tcl_AppendResult(interp, "cannot rename method to itself",
-			NULL);
-		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL);
-		return TCL_ERROR;
-	    } else if (!isNew) {
-	    renameToExisting:
-		Tcl_AppendResult(interp, "method called ",
-			TclGetString(toPtr), " already exists", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL);
-		return TCL_ERROR;
-	    }
-	}
-    } else {
-	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
-		(char *) fromPtr);
-	if (hPtr == NULL) {
-	    goto noSuchMethod;
-	}
-	if (toPtr) {
-	    newHPtr = Tcl_CreateHashEntry(&oPtr->classPtr->classMethods,
-		    (char *) toPtr, &isNew);
-	    if (hPtr == newHPtr) {
-		goto renameToSelf;
-	    } else if (!isNew) {
-		goto renameToExisting;
-	    }
-	}
-    }
-
-    /*
-     * Complete the splicing by changing the method's name.
-     */
-
-    mPtr = Tcl_GetHashValue(hPtr);
-    if (toPtr) {
-	Tcl_IncrRefCount(toPtr);
-	Tcl_DecrRefCount(mPtr->namePtr);
-	mPtr->namePtr = toPtr;
-	Tcl_SetHashValue(newHPtr, mPtr);
-    } else {
-	if (!useClass) {
-	    RecomputeClassCacheFlag(oPtr);
-	}
-	TclOODelMethodRef(mPtr);
-    }
-    Tcl_DeleteHashEntry(hPtr);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOUnknownDefinition --
- *	Handles what happens when an unknown command is encountered during the
- *	processing of a definition script. Works by finding a command in the
- *	operating definition namespace that the requested command is a unique
- *	prefix of.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOUnknownDefinition(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    Tcl_HashSearch search;
-    Tcl_HashEntry *hPtr;
-    int soughtLen;
-    const char *soughtStr, *matchedStr = NULL;
-
-    if (objc < 2) {
-	Tcl_AppendResult(interp, "bad call of unknown handler", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
-	return TCL_ERROR;
-    }
-    if (TclOOGetDefineCmdContext(interp) == NULL) {
-	return TCL_ERROR;
-    }
-
-    soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen);
-    if (soughtLen == 0) {
-	goto noMatch;
-    }
-    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
-    while (hPtr != NULL) {
-	const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
-
-	if (strncmp(soughtStr, nameStr, soughtLen) == 0) {
-	    if (matchedStr != NULL) {
-		goto noMatch;
-	    }
-	    matchedStr = nameStr;
-	}
-	hPtr = Tcl_NextHashEntry(&search);
-    }
-
-    if (matchedStr != NULL) {
-	/*
-	 * Got one match, and only one match!
-	 */
-
-	Tcl_Obj **newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj*)*(objc-1));
-	int result;
-
-	newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
-	Tcl_IncrRefCount(newObjv[0]);
-	if (objc > 2) {
-	    memcpy(newObjv+1, objv+2, sizeof(Tcl_Obj *) * (objc-2));
-	}
-	result = Tcl_EvalObjv(interp, objc-1, newObjv, 0);
-	Tcl_DecrRefCount(newObjv[0]);
-	TclStackFree(interp, newObjv);
-	return result;
-    }
-
-  noMatch:
-    Tcl_AppendResult(interp, "invalid command name \"",soughtStr,"\"", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL);
-    return TCL_ERROR;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * FindCommand --
- *	Specialized version of Tcl_FindCommand that handles command prefixes
- *	and disallows namespace magic.
- *
- * ----------------------------------------------------------------------
- */
-
-static Tcl_Command
-FindCommand(
-    Tcl_Interp *interp,
-    Tcl_Obj *stringObj,
-    Tcl_Namespace *const namespacePtr)
-{
-    int length;
-    const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
-    register Namespace *const nsPtr = (Namespace *) namespacePtr;
-    FOREACH_HASH_DECLS;
-    Tcl_Command cmd, cmd2;
-
-    /*
-     * If someone is playing games, we stop playing right now.
-     */
-
-    if (string[0] == '\0' || strstr(string, "::") != NULL) {
-	return NULL;
-    }
-
-    /*
-     * Do the exact lookup first.
-     */
-
-    cmd = Tcl_FindCommand(interp, string, namespacePtr, TCL_NAMESPACE_ONLY);
-    if (cmd != NULL) {
-	return cmd;
-    }
-
-    /*
-     * Bother, need to perform an approximate match. Iterate across the hash
-     * table of commands in the namespace.
-     */
-
-    FOREACH_HASH(nameStr, cmd2, &nsPtr->cmdTable) {
-	if (strncmp(string, nameStr, length) == 0) {
-	    if (cmd != NULL) {
-		return NULL;
-	    }
-	    cmd = cmd2;
-	}
-    }
-
-    /*
-     * Either we found one thing or we found nothing. Either way, return it.
-     */
-
-    return cmd;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InitDefineContext --
- *	Does the magic incantations necessary to push the special stack frame
- *	used when processing object definitions. It is up to the caller to
- *	dispose of the frame (with TclPopStackFrame) when finished.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline int
-InitDefineContext(
-    Tcl_Interp *interp,
-    Tcl_Namespace *namespacePtr,
-    Object *oPtr,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    CallFrame *framePtr, **framePtrPtr = &framePtr;
-    int result;
-
-    if (namespacePtr == NULL) {
-	Tcl_AppendResult(interp,
-		"cannot process definitions; support namespace deleted",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
-
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
-	    namespacePtr, FRAME_IS_OO_DEFINE);
-    if (result != TCL_OK) {
-	return TCL_ERROR;
-    }
-    framePtr->clientData = oPtr;
-    framePtr->objc = objc;
-    framePtr->objv = objv;	/* Reference counts do not need to be
-				 * incremented here. */
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOGetDefineCmdContext --
- *	Extracts the magic token from the current stack frame, or returns NULL
- *	(and leaves an error message) otherwise.
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Object
-TclOOGetDefineCmdContext(
-    Tcl_Interp *interp)
-{
-    Interp *iPtr = (Interp *) interp;
-
-    if ((iPtr->varFramePtr == NULL)
-	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
-	Tcl_AppendResult(interp, "this command may only be called from within"
-		" the context of an ::oo::define or ::oo::objdefine command",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return NULL;
-    }
-    return (Tcl_Object) iPtr->varFramePtr->clientData;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * GetClassInOuterContext --
- *	Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
- *	context that called oo::define (or equivalent). Note that this may
- *	have to go up multiple levels to get the level that we started doing
- *	definitions at.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline Class *
-GetClassInOuterContext(
-    Tcl_Interp *interp,
-    Tcl_Obj *className,
-    const char *errMsg)
-{
-    Interp *iPtr = (Interp *) interp;
-    Object *oPtr;
-    CallFrame *savedFramePtr = iPtr->varFramePtr;
-
-    while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) {
-	if (iPtr->varFramePtr->callerVarPtr == NULL) {
-	    Tcl_Panic("getting outer context when already in global context");
-	}
-	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, className);
-    iPtr->varFramePtr = savedFramePtr;
-    if (oPtr == NULL) {
-	return NULL;
-    }
-    if (oPtr->classPtr == NULL) {
-	Tcl_AppendResult(interp, errMsg, NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
-		TclGetString(className), NULL);
-	return NULL;
-    }
-    return oPtr->classPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineObjCmd --
- *	Implementation of the "oo::define" command. Works by effectively doing
- *	the same as 'namespace eval', but with extra magic applied so that the
- *	object to be modified is known to the commands in the target
- *	namespace. Also does ensemble-like tricks with dispatch so that error
- *	messages are clearer.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Foundation *fPtr = TclOOGetFoundation(interp);
-    int result;
-    Object *oPtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (oPtr->classPtr == NULL) {
-	Tcl_AppendResult(interp, TclGetString(objv[1]),
-		" does not refer to a class", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
-		TclGetString(objv[1]), NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the oo::define namespace the current namespace and evaluate the
-     * command(s).
-     */
-
-    if (InitDefineContext(interp, fPtr->defineNs, oPtr, objc,objv) != TCL_OK){
-	return TCL_ERROR;
-    }
-
-    AddRef(oPtr);
-    if (objc == 3) {
-	result = TclEvalObjEx(interp, objv[2], 0,
-		((Interp *)interp)->cmdFramePtr, 2);
-
-	if (result == TCL_ERROR) {
-	    int length;
-	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
-	    int limit = 60;
-	    int overflow = (length > limit);
-
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (in definition script for object \"%.*s%s\" line %d)",
-		    (overflow ? limit : length), objName,
-		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
-	}
-    } else {
-	Tcl_Obj *objPtr, *obj2Ptr, **objs;
-	Interp *iPtr = (Interp *) interp;
-	Tcl_Command cmd;
-	int dummy;
-
-	/*
-	 * More than one argument: fire them through the ensemble processing
-	 * engine so that everything appears to be good and proper in error
-	 * messages. Note that we cannot just concatenate and send through
-	 * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
-	 * cannot go through Tcl_EvalObjv without the extra work to pre-find
-	 * the command, as that finds command names in the wrong namespace at
-	 * the moment. Ugly!
-	 */
-
-	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
-	    iPtr->ensembleRewrite.sourceObjs = objv;
-	    iPtr->ensembleRewrite.numRemovedObjs = 3;
-	    iPtr->ensembleRewrite.numInsertedObjs = 1;
-	} else {
-	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
-	    if (ni < 3) {
-		iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
-	    } else {
-		iPtr->ensembleRewrite.numInsertedObjs -= 2;
-	    }
-	}
-
-	/*
-	 * Build the list of arguments using a Tcl_Obj as a workspace. See
-	 * comments above for why these contortions are necessary.
-	 */
-
-	objPtr = Tcl_NewObj();
-	obj2Ptr = Tcl_NewObj();
-	cmd = FindCommand(interp, objv[2], fPtr->defineNs);
-	if (cmd == NULL) {
-	    /* punt this case! */
-	    Tcl_AppendObjToObj(obj2Ptr, objv[2]);
-	} else {
-	    Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
-	}
-	Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
-	Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
-	Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
-
-	result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
-	Tcl_DecrRefCount(objPtr);
-    }
-    DelRef(oPtr);
-
-    /*
-     * Restore the previous "current" namespace.
-     */
-
-    TclPopStackFrame(interp);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOObjDefObjCmd --
- *	Implementation of the "oo::objdefine" command. Works by effectively
- *	doing the same as 'namespace eval', but with extra magic applied so
- *	that the object to be modified is known to the commands in the target
- *	namespace. Also does ensemble-like tricks with dispatch so that error
- *	messages are clearer.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOOObjDefObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Foundation *fPtr = TclOOGetFoundation(interp);
-    int result;
-    Object *oPtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the oo::objdefine namespace the current namespace and evaluate the
-     * command(s).
-     */
-
-    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
-	return TCL_ERROR;
-    }
-
-    AddRef(oPtr);
-    if (objc == 3) {
-	result = TclEvalObjEx(interp, objv[2], 0,
-		((Interp *)interp)->cmdFramePtr, 2);
-
-	if (result == TCL_ERROR) {
-	    int length;
-	    const char *objName = Tcl_GetStringFromObj(objv[1], &length);
-	    int limit = 60;
-	    int overflow = (length > limit);
-
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (in definition script for object \"%.*s%s\" line %d)",
-		    (overflow ? limit : length), objName,
-		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
-	}
-    } else {
-	Tcl_Obj *objPtr, *obj2Ptr, **objs;
-	Interp *iPtr = (Interp *) interp;
-	Tcl_Command cmd;
-	int dummy;
-
-	/*
-	 * More than one argument: fire them through the ensemble processing
-	 * engine so that everything appears to be good and proper in error
-	 * messages. Note that we cannot just concatenate and send through
-	 * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
-	 * cannot go through Tcl_EvalObjv without the extra work to pre-find
-	 * the command, as that finds command names in the wrong namespace at
-	 * the moment. Ugly!
-	 */
-
-	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
-	    iPtr->ensembleRewrite.sourceObjs = objv;
-	    iPtr->ensembleRewrite.numRemovedObjs = 3;
-	    iPtr->ensembleRewrite.numInsertedObjs = 1;
-	} else {
-	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
-	    if (ni < 3) {
-		iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
-	    } else {
-		iPtr->ensembleRewrite.numInsertedObjs -= 2;
-	    }
-	}
-
-	/*
-	 * Build the list of arguments using a Tcl_Obj as a workspace. See
-	 * comments above for why these contortions are necessary.
-	 */
-
-	objPtr = Tcl_NewObj();
-	obj2Ptr = Tcl_NewObj();
-	cmd = FindCommand(interp, objv[2], fPtr->objdefNs);
-	if (cmd == NULL) {
-	    /* punt this case! */
-	    Tcl_AppendObjToObj(obj2Ptr, objv[2]);
-	} else {
-	    Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
-	}
-	Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
-	Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
-	Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
-
-	result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
-	Tcl_DecrRefCount(objPtr);
-    }
-    DelRef(oPtr);
-
-    /*
-     * Restore the previous "current" namespace.
-     */
-
-    TclPopStackFrame(interp);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineSelfObjCmd --
- *	Implementation of the "self" subcommand of the "oo::define" command.
- *	Works by effectively doing the same as 'namespace eval', but with
- *	extra magic applied so that the object to be modified is known to the
- *	commands in the target namespace. Also does ensemble-like tricks with
- *	dispatch so that error messages are clearer.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineSelfObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Foundation *fPtr = TclOOGetFoundation(interp);
-    int result;
-    Object *oPtr;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make the oo::objdefine namespace the current namespace and evaluate the
-     * command(s).
-     */
-
-    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
-	return TCL_ERROR;
-    }
-
-    AddRef(oPtr);
-    if (objc == 2) {
-	result = TclEvalObjEx(interp, objv[1], 0,
-		((Interp *)interp)->cmdFramePtr, 2);
-
-	if (result == TCL_ERROR) {
-	    int length;
-	    const char *objName = Tcl_GetStringFromObj(
-		    TclOOObjectName(interp, oPtr), &length);
-	    int limit = 60;
-	    int overflow = (length > limit);
-
-	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		    "\n    (in definition script for object \"%.*s%s\" line %d)",
-		    (overflow ? limit : length), objName,
-		    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
-	}
-    } else {
-	Tcl_Obj *objPtr, *obj2Ptr, **objs;
-	Interp *iPtr = (Interp *) interp;
-	Tcl_Command cmd;
-	int dummy;
-
-	/*
-	 * More than one argument: fire them through the ensemble processing
-	 * engine so that everything appears to be good and proper in error
-	 * messages. Note that we cannot just concatenate and send through
-	 * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
-	 * cannot go through Tcl_EvalObjv without the extra work to pre-find
-	 * the command, as that finds command names in the wrong namespace at
-	 * the moment. Ugly!
-	 */
-
-	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
-	    iPtr->ensembleRewrite.sourceObjs = objv;
-	    iPtr->ensembleRewrite.numRemovedObjs = 2;
-	    iPtr->ensembleRewrite.numInsertedObjs = 1;
-	} else {
-	    int ni = iPtr->ensembleRewrite.numInsertedObjs;
-	    if (ni < 2) {
-		iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
-	    } else {
-		iPtr->ensembleRewrite.numInsertedObjs -= 1;
-	    }
-	}
-
-	/*
-	 * Build the list of arguments using a Tcl_Obj as a workspace. See
-	 * comments above for why these contortions are necessary.
-	 */
-
-	objPtr = Tcl_NewObj();
-	obj2Ptr = Tcl_NewObj();
-	cmd = FindCommand(interp, objv[1], fPtr->objdefNs);
-	if (cmd == NULL) {
-	    /* punt this case! */
-	    Tcl_AppendObjToObj(obj2Ptr, objv[1]);
-	} else {
-	    Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
-	}
-	Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
-	Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-2, objv+2);
-	Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
-
-	result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE);
-	Tcl_DecrRefCount(objPtr);
-    }
-    DelRef(oPtr);
-
-    /*
-     * Restore the previous "current" namespace.
-     */
-
-    TclPopStackFrame(interp);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineClassObjCmd --
- *	Implementation of the "class" subcommand of the "oo::objdefine"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineClassObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr;
-    Class *clsPtr;
-    Foundation *fPtr = TclOOGetFoundation(interp);
-
-    /*
-     * Parse the context to get the object to operate on.
-     */
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (oPtr->flags & ROOT_OBJECT) {
-	Tcl_AppendResult(interp,
-		"may not modify the class of the root object class", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-    if (oPtr->flags & ROOT_CLASS) {
-	Tcl_AppendResult(interp,
-		"may not modify the class of the class of classes", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Parse the argument to get the class to set the object's class to.
-     */
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassInOuterContext(interp, objv[1],
-	    "the class of an object must be a class");
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Apply semantic checks. In particular, classes and non-classes are not
-     * interchangable (too complicated to do the conversion!) so we must
-     * produce an error if any attempt is made to swap from one to the other.
-     */
-
-    if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
-	Tcl_AppendResult(interp, "may not change a ",
-		(oPtr->classPtr==NULL ? "non-" : ""), "class object into a ",
-		(oPtr->classPtr==NULL ? "" : "non-"), "class object", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Set the object's class.
-     */
-
-    if (oPtr->selfCls != clsPtr) {
-	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
-	oPtr->selfCls = clsPtr;
-	TclOOAddToInstances(oPtr, oPtr->selfCls);
-	if (oPtr->classPtr != NULL) {
-	    BumpGlobalEpoch(interp, oPtr->classPtr);
-	} else {
-	    oPtr->epoch++;
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineConstructorObjCmd --
- *	Implementation of the "constructor" subcommand of the "oo::define"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineConstructorObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr;
-    Class *clsPtr;
-    Tcl_Method method;
-    int bodyLength;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arguments body");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Extract and validate the context, which is the class that we wish to
-     * modify.
-     */
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-
-    Tcl_GetStringFromObj(objv[2], &bodyLength);
-    if (bodyLength > 0) {
-	/*
-	 * Create the method structure.
-	 */
-
-	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
-		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);
-	if (method == NULL) {
-	    return TCL_ERROR;
-	}
-    } else {
-	/*
-	 * Delete the constructor method record and set the field in the
-	 * class record to NULL.
-	 */
-
-	method = NULL;
-    }
-
-    /*
-     * Place the method structure in the class record. Note that we might not
-     * immediately delete the constructor as this might be being done during
-     * execution of the constructor itself.
-     */
-
-    Tcl_ClassSetConstructor(interp, (Tcl_Class) clsPtr, method);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineDeleteMethodObjCmd --
- *	Implementation of the "deletemethod" subcommand of the "oo::define"
- *	and "oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineDeleteMethodObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceDeleteMethod = (clientData != NULL);
-    Object *oPtr;
-    int i;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (!isInstanceDeleteMethod && !oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    for (i=1 ; i<objc ; i++) {
-	/*
-	 * Delete the method structure from the appropriate hash table.
-	 */
-
-	if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
-		objv[i], NULL) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-    }
-
-    if (isInstanceDeleteMethod) {
-	oPtr->epoch++;
-    } else {
-	BumpGlobalEpoch(interp, oPtr->classPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineDestructorObjCmd --
- *	Implementation of the "destructor" subcommand of the "oo::define"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineDestructorObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr;
-    Class *clsPtr;
-    Tcl_Method method;
-    int bodyLength;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "body");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-
-    Tcl_GetStringFromObj(objv[1], &bodyLength);
-    if (bodyLength > 0) {
-	/*
-	 * Create the method structure.
-	 */
-
-	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
-		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
-	if (method == NULL) {
-	    return TCL_ERROR;
-	}
-    } else {
-	/*
-	 * Delete the destructor method record and set the field in the class
-	 * record to NULL.
-	 */
-
-	method = NULL;
-    }
-
-    /*
-     * Place the method structure in the class record. Note that we might not
-     * immediately delete the destructor as this might be being done during
-     * execution of the destructor itself. Also note that setting a
-     * destructor during a destructor is fairly dumb anyway.
-     */
-
-    Tcl_ClassSetDestructor(interp, (Tcl_Class) clsPtr, method);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineExportObjCmd --
- *	Implementation of the "export" subcommand of the "oo::define" and
- *	"oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineExportObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceExport = (clientData != NULL);
-    Object *oPtr;
-    Method *mPtr;
-    Tcl_HashEntry *hPtr;
-    Class *clsPtr;
-    int i, isNew, changed = 0;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-    if (!isInstanceExport && !clsPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    for (i=1 ; i<objc ; i++) {
-	/*
-	 * Exporting is done by adding the PUBLIC_METHOD flag to the method
-	 * record. If there is no such method in this object or class (i.e.
-	 * the method comes from something inherited from or that we're an
-	 * instance of) then we put in a blank record with that flag; such
-	 * records are skipped over by the call chain engine *except* for
-	 * their flags member.
-	 */
-
-	if (isInstanceExport) {
-	    if (!oPtr->methodsPtr) {
-		oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
-		Tcl_InitObjHashTable(oPtr->methodsPtr);
-		oPtr->flags &= ~USE_CLASS_CACHE;
-	    }
-	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
-		    &isNew);
-	} else {
-	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
-		    &isNew);
-	}
-
-	if (isNew) {
-	    mPtr = ckalloc(sizeof(Method));
-	    memset(mPtr, 0, sizeof(Method));
-	    mPtr->refCount = 1;
-	    mPtr->namePtr = objv[i];
-	    Tcl_IncrRefCount(objv[i]);
-	    Tcl_SetHashValue(hPtr, mPtr);
-	} else {
-	    mPtr = Tcl_GetHashValue(hPtr);
-	}
-	if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
-	    mPtr->flags |= PUBLIC_METHOD;
-	    changed = 1;
-	}
-    }
-
-    /*
-     * Bump the right epoch if we actually changed anything.
-     */
-
-    if (changed) {
-	if (isInstanceExport) {
-	    oPtr->epoch++;
-	} else {
-	    BumpGlobalEpoch(interp, clsPtr);
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineForwardObjCmd --
- *	Implementation of the "forward" subcommand of the "oo::define" and
- *	"oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineForwardObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceForward = (clientData != NULL);
-    Object *oPtr;
-    Method *mPtr;
-    int isPublic;
-    Tcl_Obj *prefixObj;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name cmdName ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (!isInstanceForward && !oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
-	    ? PUBLIC_METHOD : 0;
-
-    /*
-     * Create the method structure.
-     */
-
-    prefixObj = Tcl_NewListObj(objc-2, objv+2);
-    if (isInstanceForward) {
-	mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1],
-		prefixObj);
-    } else {
-	mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic,
-		objv[1], prefixObj);
-    }
-    if (mPtr == NULL) {
-	Tcl_DecrRefCount(prefixObj);
-	return TCL_ERROR;
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineMethodObjCmd --
- *	Implementation of the "method" subcommand of the "oo::define" and
- *	"oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineMethodObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceMethod = (clientData != NULL);
-    Object *oPtr;
-    int isPublic;
-
-    if (objc != 4) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (!isInstanceMethod && !oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-    isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
-	    ? PUBLIC_METHOD : 0;
-
-    /*
-     * Create the method by using the right back-end API.
-     */
-
-    if (isInstanceMethod) {
-	if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1],
-		objv[2], objv[3], NULL) == NULL) {
-	    return TCL_ERROR;
-	}
-    } else {
-	if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1],
-		objv[2], objv[3], NULL) == NULL) {
-	    return TCL_ERROR;
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineMixinObjCmd --
- *	Implementation of the "mixin" subcommand of the "oo::define" and
- *	"oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineMixinObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    const int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceMixin = (clientData != NULL);
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Class **mixins;
-    int i;
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (!isInstanceMixin && !oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-    mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
-
-    for (i=1 ; i<objc ; i++) {
-	Class *clsPtr = GetClassInOuterContext(interp, objv[i],
-		"may only mix in classes");
-
-	if (clsPtr == NULL) {
-	    goto freeAndError;
-	}
-	if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
-	    Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
-	    goto freeAndError;
-	}
-	mixins[i-1] = clsPtr;
-    }
-
-    if (isInstanceMixin) {
-	TclOOObjectSetMixins(oPtr, objc-1, mixins);
-    } else {
-	TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
-    }
-
-    TclStackFree(interp, mixins);
-    return TCL_OK;
-
-  freeAndError:
-    TclStackFree(interp, mixins);
-    return TCL_ERROR;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineRenameMethodObjCmd --
- *	Implementation of the "renamemethod" subcommand of the "oo::define"
- *	and "oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineRenameMethodObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceRenameMethod = (clientData != NULL);
-    Object *oPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (!isInstanceRenameMethod && !oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Delete the method entry from the appropriate hash table, and transfer
-     * the thing it points to to its new entry. To do this, we first need to
-     * get the entries from the appropriate hash tables (this can generate a
-     * range of errors...)
-     */
-
-    if (RenameDeleteMethod(interp, oPtr, !isInstanceRenameMethod,
-	    objv[1], objv[2]) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    if (isInstanceRenameMethod) {
-	oPtr->epoch++;
-    } else {
-	BumpGlobalEpoch(interp, oPtr->classPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineUnexportObjCmd --
- *	Implementation of the "unexport" subcommand of the "oo::define" and
- *	"oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineUnexportObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceUnexport = (clientData != NULL);
-    Object *oPtr;
-    Method *mPtr;
-    Tcl_HashEntry *hPtr;
-    Class *clsPtr;
-    int i, isNew, changed = 0;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    clsPtr = oPtr->classPtr;
-    if (!isInstanceUnexport && !clsPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    for (i=1 ; i<objc ; i++) {
-	/*
-	 * Unexporting is done by removing the PUBLIC_METHOD flag from the
-	 * method record. If there is no such method in this object or class
-	 * (i.e. the method comes from something inherited from or that we're
-	 * an instance of) then we put in a blank record without that flag;
-	 * such records are skipped over by the call chain engine *except* for
-	 * their flags member.
-	 */
-
-	if (isInstanceUnexport) {
-	    if (!oPtr->methodsPtr) {
-		oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
-		Tcl_InitObjHashTable(oPtr->methodsPtr);
-		oPtr->flags &= ~USE_CLASS_CACHE;
-	    }
-	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
-		    &isNew);
-	} else {
-	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
-		    &isNew);
-	}
-
-	if (isNew) {
-	    mPtr = ckalloc(sizeof(Method));
-	    memset(mPtr, 0, sizeof(Method));
-	    mPtr->refCount = 1;
-	    mPtr->namePtr = objv[i];
-	    Tcl_IncrRefCount(objv[i]);
-	    Tcl_SetHashValue(hPtr, mPtr);
-	} else {
-	    mPtr = Tcl_GetHashValue(hPtr);
-	}
-	if (isNew || mPtr->flags & PUBLIC_METHOD) {
-	    mPtr->flags &= ~PUBLIC_METHOD;
-	    changed = 1;
-	}
-    }
-
-    /*
-     * Bump the right epoch if we actually changed anything.
-     */
-
-    if (changed) {
-	if (isInstanceUnexport) {
-	    oPtr->epoch++;
-	} else {
-	    BumpGlobalEpoch(interp, clsPtr);
-	}
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
- *	How to install a constructor or destructor into a class; API to call
- *	from C.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-Tcl_ClassSetConstructor(
-    Tcl_Interp *interp,
-    Tcl_Class clazz,
-    Tcl_Method method)
-{
-    Class *clsPtr = (Class *) clazz;
-
-    if (method != (Tcl_Method) clsPtr->constructorPtr) {
-	TclOODelMethodRef(clsPtr->constructorPtr);
-	clsPtr->constructorPtr = (Method *) method;
-
-	/*
-	 * Remember to invalidate the cached constructor chain for this class.
-	 * [Bug 2531577]
-	 */
-
-	if (clsPtr->constructorChainPtr) {
-	    TclOODeleteChain(clsPtr->constructorChainPtr);
-	    clsPtr->constructorChainPtr = NULL;
-	}
-	BumpGlobalEpoch(interp, clsPtr);
-    }
-}
-
-void
-Tcl_ClassSetDestructor(
-    Tcl_Interp *interp,
-    Tcl_Class clazz,
-    Tcl_Method method)
-{
-    Class *clsPtr = (Class *) clazz;
-
-    if (method != (Tcl_Method) clsPtr->destructorPtr) {
-	TclOODelMethodRef(clsPtr->destructorPtr);
-	clsPtr->destructorPtr = (Method *) method;
-	if (clsPtr->destructorChainPtr) {
-	    TclOODeleteChain(clsPtr->destructorChainPtr);
-	    clsPtr->destructorChainPtr = NULL;
-	}
-	BumpGlobalEpoch(interp, clsPtr);
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODefineSlots --
- *	Create the "::oo::Slot" class and its standard instances. Class
- *	definition is empty at the stage (added by scripting).
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineSlots(
-    Foundation *fPtr)
-{
-    const struct DeclaredSlot *slotInfoPtr;
-    Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
-    Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
-    Class *slotCls;
-
-    slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
-	    fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr;
-    if (slotCls == NULL) {
-	return TCL_ERROR;
-    }
-    Tcl_IncrRefCount(getName);
-    Tcl_IncrRefCount(setName);
-    for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
-	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
-		(Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);
-
-	if (slotObject == NULL) {
-	    continue;
-	}
-	Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0,
-		&slotInfoPtr->getterType, NULL);
-	Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
-		&slotInfoPtr->setterType, NULL);
-    }
-    Tcl_DecrRefCount(getName);
-    Tcl_DecrRefCount(setName);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ClassFilterGet, ClassFilterSet --
- *	Implementation of the "filter" slot accessors of the "oo::define"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-ClassFilterGet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Tcl_Obj *resultObj, *filterObj;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    }
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(filterObj, oPtr->classPtr->filters) {
-	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-static int
-ClassFilterSet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int filterc;
-    Tcl_Obj **filterv;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"filterList");
-	return TCL_ERROR;
-    }
-    objv += Tcl_ObjectContextSkippedArgs(context);
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    } else if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
-	    &filterv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    TclOOClassSetFilters(interp, oPtr->classPtr, filterc, filterv);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ClassMixinGet, ClassMixinSet --
- *	Implementation of the "mixin" slot accessors of the "oo::define"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-ClassMixinGet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Tcl_Obj *resultObj;
-    Class *mixinPtr;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    }
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(mixinPtr, oPtr->classPtr->mixins) {
-	Tcl_ListObjAppendElement(NULL, resultObj,
-		TclOOObjectName(interp, mixinPtr->thisPtr));
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-
-}
-
-static int
-ClassMixinSet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc, i;
-    Tcl_Obj **mixinv;
-    Class **mixins;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"mixinList");
-	return TCL_ERROR;
-    }
-    objv += Tcl_ObjectContextSkippedArgs(context);
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
-	    &mixinv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
-
-    for (i=0 ; i<mixinc ; i++) {
-	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
-		"may only mix in classes");
-	if (mixins[i] == NULL) {
-	    goto freeAndError;
-	}
-	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
-	    Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
-	    goto freeAndError;
-	}
-    }
-
-    TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
-    TclStackFree(interp, mixins);
-    return TCL_OK;
-
-  freeAndError:
-    TclStackFree(interp, mixins);
-    return TCL_ERROR;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ClassSuperGet, ClassSuperSet --
- *	Implementation of the "superclass" slot accessors of the "oo::define"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-ClassSuperGet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Tcl_Obj *resultObj;
-    Class *superPtr;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    }
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(superPtr, oPtr->classPtr->superclasses) {
-	Tcl_ListObjAppendElement(NULL, resultObj,
-		TclOOObjectName(interp, superPtr->thisPtr));
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-static int
-ClassSuperSet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int superc, i, j;
-    Tcl_Obj **superv;
-    Class **superclasses, *superPtr;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"superclassList");
-	return TCL_ERROR;
-    }
-    objv += Tcl_ObjectContextSkippedArgs(context);
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
-	Tcl_AppendResult(interp,
-		"may not modify the superclass of the root object", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    } else if (Tcl_ListObjGetElements(interp, objv[0], &superc,
-	    &superv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Allocate some working space.
-     */
-
-    superclasses = (Class **) ckalloc(sizeof(Class *) * superc);
-
-    /*
-     * Parse the arguments to get the class to use as superclasses.
-     */
-
-    for (i=0 ; i<superc ; i++) {
-	superclasses[i] = GetClassInOuterContext(interp, superv[i],
-		"only a class can be a superclass");
-	if (superclasses[i] == NULL) {
-	    goto failedAfterAlloc;
-	}
-	for (j=0 ; j<i ; j++) {
-	    if (superclasses[j] == superclasses[i]) {
-		Tcl_AppendResult(interp,
-			"class should only be a direct superclass once",NULL);
-		Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
-		goto failedAfterAlloc;
-	    }
-	}
-	if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
-	    Tcl_AppendResult(interp,
-		    "attempt to form circular dependency graph", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
-	failedAfterAlloc:
-	    ckfree((char *) superclasses);
-	    return TCL_ERROR;
-	}
-    }
-
-    /*
-     * Install the list of superclasses into the class. Note that this also
-     * involves splicing the class out of the superclasses' subclass list that
-     * it used to be a member of and splicing it into the new superclasses'
-     * subclass list.
-     */
-
-    if (oPtr->classPtr->superclasses.num != 0) {
-	FOREACH(superPtr, oPtr->classPtr->superclasses) {
-	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
-	}
-	ckfree((char *) oPtr->classPtr->superclasses.list);
-    }
-    oPtr->classPtr->superclasses.list = superclasses;
-    oPtr->classPtr->superclasses.num = superc;
-    FOREACH(superPtr, oPtr->classPtr->superclasses) {
-	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
-    }
-    BumpGlobalEpoch(interp, oPtr->classPtr);
-
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ClassVarsGet, ClassVarsSet --
- *	Implementation of the "variable" slot accessors of the "oo::define"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-ClassVarsGet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Tcl_Obj *resultObj, *variableObj;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    }
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(variableObj, oPtr->classPtr->variables) {
-	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-static int
-ClassVarsSet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int varc;
-    Tcl_Obj **varv, *variableObj;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"filterList");
-	return TCL_ERROR;
-    }
-    objv += Tcl_ObjectContextSkippedArgs(context);
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    } else if (!oPtr->classPtr) {
-	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
-	    &varv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    for (i=0 ; i<varc ; i++) {
-	const char *varName = Tcl_GetString(varv[i]);
-
-	if (strstr(varName, "::") != NULL) {
-	    Tcl_AppendResult(interp, "invalid declared variable name \"",
-		    varName, "\": must not contain namespace separators",
-		    NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_StringMatch(varName, "*(*)")) {
-	    Tcl_AppendResult(interp, "invalid declared variable name \"",
-		    varName, "\": must not refer to an array element", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
-	    return TCL_ERROR;
-	}
-    }
-
-    for (i=0 ; i<varc ; i++) {
-	Tcl_IncrRefCount(varv[i]);
-    }
-    FOREACH(variableObj, oPtr->classPtr->variables) {
-	Tcl_DecrRefCount(variableObj);
-    }
-    if (i != varc) {
-	if (varc == 0) {
-	    ckfree((char *) oPtr->classPtr->variables.list);
-	} else if (i) {
-	    oPtr->classPtr->variables.list = (Tcl_Obj **)
-		    ckrealloc((char *) oPtr->classPtr->variables.list,
-		    sizeof(Tcl_Obj *) * varc);
-	} else {
-	    oPtr->classPtr->variables.list = (Tcl_Obj **)
-		    ckalloc(sizeof(Tcl_Obj *) * varc);
-	}
-    }
-
-    oPtr->classPtr->variables.num = 0;
-    if (varc > 0) {
-	int created, n;
-	Tcl_HashTable uniqueTable;
-
-	Tcl_InitObjHashTable(&uniqueTable);
-	for (i=n=0 ; i<varc ; i++) {
-	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
-	    if (created) {
-		oPtr->classPtr->variables.list[n++] = varv[i];
-	    } else {
-		Tcl_DecrRefCount(varv[i]);
-	    }
-	}
-	oPtr->classPtr->variables.num = n;
-
-	/*
-	 * Shouldn't be necessary, but maintain num/list invariant.
-	 */
-
-	oPtr->classPtr->variables.list = (Tcl_Obj **)
-		ckrealloc((char *) oPtr->classPtr->variables.list,
-		sizeof(Tcl_Obj *) * n);
-	Tcl_DeleteHashTable(&uniqueTable);
-    }
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ObjectFilterGet, ObjectFilterSet --
- *	Implementation of the "filter" slot accessors of the "oo::objdefine"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-ObjFilterGet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Tcl_Obj *resultObj, *filterObj;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    } else if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(filterObj, oPtr->filters) {
-	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-static int
-ObjFilterSet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int filterc;
-    Tcl_Obj **filterv;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"filterList");
-	return TCL_ERROR;
-    } else if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    objv += Tcl_ObjectContextSkippedArgs(context);
-    if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
-	    &filterv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    TclOOObjectSetFilters(oPtr, filterc, filterv);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ObjectMixinGet, ObjectMixinSet --
- *	Implementation of the "mixin" slot accessors of the "oo::objdefine"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-ObjMixinGet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Tcl_Obj *resultObj;
-    Class *mixinPtr;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    } else if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(mixinPtr, oPtr->mixins) {
-	Tcl_ListObjAppendElement(NULL, resultObj,
-		TclOOObjectName(interp, mixinPtr->thisPtr));
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-static int
-ObjMixinSet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int mixinc;
-    Tcl_Obj **mixinv;
-    Class **mixins;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"mixinList");
-	return TCL_ERROR;
-    } else if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    objv += Tcl_ObjectContextSkippedArgs(context);
-    if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
-	    &mixinv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
-
-    for (i=0 ; i<mixinc ; i++) {
-	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
-		"may only mix in classes");
-	if (mixins[i] == NULL) {
-	    TclStackFree(interp, mixins);
-	    return TCL_ERROR;
-	}
-    }
-
-    TclOOObjectSetMixins(oPtr, mixinc, mixins);
-    TclStackFree(interp, mixins);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * ObjectVarsGet, ObjectVarsSet --
- *	Implementation of the "variable" slot accessors of the "oo::objdefine"
- *	command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-ObjVarsGet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Tcl_Obj *resultObj, *variableObj;
-    int i;
-
-    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		NULL);
-	return TCL_ERROR;
-    } else if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(variableObj, oPtr->variables) {
-	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-static int
-ObjVarsSet(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,
-    int objc,
-    Tcl_Obj *const *objv)
-{
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    int varc, i;
-    Tcl_Obj **varv, *variableObj;
-
-    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
-	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
-		"variableList");
-	return TCL_ERROR;
-    } else if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    objv += Tcl_ObjectContextSkippedArgs(context);
-    if (Tcl_ListObjGetElements(interp, objv[0], &varc,
-	    &varv) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    for (i=0 ; i<varc ; i++) {
-	const char *varName = Tcl_GetString(varv[i]);
-
-	if (strstr(varName, "::") != NULL) {
-	    Tcl_AppendResult(interp, "invalid declared variable name \"",
-		    varName, "\": must not contain namespace separators",
-		    NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_StringMatch(varName, "*(*)")) {
-	    Tcl_AppendResult(interp, "invalid declared variable name \"",
-		    varName, "\": must not refer to an array element", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
-	    return TCL_ERROR;
-	}
-    }
-    for (i=0 ; i<varc ; i++) {
-	Tcl_IncrRefCount(varv[i]);
-    }
-
-    FOREACH(variableObj, oPtr->variables) {
-	Tcl_DecrRefCount(variableObj);
-    }
-    if (i != varc) {
-	if (varc == 0) {
-	    ckfree((char *) oPtr->variables.list);
-	} else if (i) {
-	    oPtr->variables.list = (Tcl_Obj **)
-		    ckrealloc((char *) oPtr->variables.list,
-		    sizeof(Tcl_Obj *) * varc);
-	} else {
-	    oPtr->variables.list = (Tcl_Obj **)
-		    ckalloc(sizeof(Tcl_Obj *) * varc);
-	}
-    }
-    oPtr->variables.num = 0;
-    if (varc > 0) {
-	int created, n;
-	Tcl_HashTable uniqueTable;
-
-	Tcl_InitObjHashTable(&uniqueTable);
-	for (i=n=0 ; i<varc ; i++) {
-	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
-	    if (created) {
-		oPtr->variables.list[n++] = varv[i];
-	    } else {
-		Tcl_DecrRefCount(varv[i]);
-	    }
-	}
-	oPtr->variables.num = n;
-
-	/*
-	 * Shouldn't be necessary, but maintain num/list invariant.
-	 */
-
-	oPtr->variables.list = (Tcl_Obj **)
-		ckrealloc((char *) oPtr->variables.list,
-		sizeof(Tcl_Obj *) * n);
-	Tcl_DeleteHashTable(&uniqueTable);
-    }
-    return TCL_OK;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
deleted file mode 100644
index f298320..0000000
--- a/generic/tclOOInfo.c
+++ /dev/null
@@ -1,1555 +0,0 @@
-/*
- * tclOODefineCmds.c --
- *
- *	This file contains the implementation of the ::oo-related [info]
- *	subcommands.
- *
- * Copyright (c) 2006-2008 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.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "tclInt.h"
-#include "tclOOInt.h"
-
-static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
-static Tcl_ObjCmdProc InfoObjectCallCmd;
-static Tcl_ObjCmdProc InfoObjectClassCmd;
-static Tcl_ObjCmdProc InfoObjectDefnCmd;
-static Tcl_ObjCmdProc InfoObjectFiltersCmd;
-static Tcl_ObjCmdProc InfoObjectForwardCmd;
-static Tcl_ObjCmdProc InfoObjectIsACmd;
-static Tcl_ObjCmdProc InfoObjectMethodsCmd;
-static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
-static Tcl_ObjCmdProc InfoObjectMixinsCmd;
-static Tcl_ObjCmdProc InfoObjectNsCmd;
-static Tcl_ObjCmdProc InfoObjectVarsCmd;
-static Tcl_ObjCmdProc InfoObjectVariablesCmd;
-static Tcl_ObjCmdProc InfoClassCallCmd;
-static Tcl_ObjCmdProc InfoClassConstrCmd;
-static Tcl_ObjCmdProc InfoClassDefnCmd;
-static Tcl_ObjCmdProc InfoClassDestrCmd;
-static Tcl_ObjCmdProc InfoClassFiltersCmd;
-static Tcl_ObjCmdProc InfoClassForwardCmd;
-static Tcl_ObjCmdProc InfoClassInstancesCmd;
-static Tcl_ObjCmdProc InfoClassMethodsCmd;
-static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
-static Tcl_ObjCmdProc InfoClassMixinsCmd;
-static Tcl_ObjCmdProc InfoClassSubsCmd;
-static Tcl_ObjCmdProc InfoClassSupersCmd;
-static Tcl_ObjCmdProc InfoClassVariablesCmd;
-
-struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };
-
-/*
- * List of commands that are used to implement the [info object] subcommands.
- */
-
-static const struct NameProcMap infoObjectCmds[] = {
-    {"::oo::InfoObject::call",		InfoObjectCallCmd},
-    {"::oo::InfoObject::class",		InfoObjectClassCmd},
-    {"::oo::InfoObject::definition",	InfoObjectDefnCmd},
-    {"::oo::InfoObject::filters",	InfoObjectFiltersCmd},
-    {"::oo::InfoObject::forward",	InfoObjectForwardCmd},
-    {"::oo::InfoObject::isa",		InfoObjectIsACmd},
-    {"::oo::InfoObject::methods",	InfoObjectMethodsCmd},
-    {"::oo::InfoObject::methodtype",	InfoObjectMethodTypeCmd},
-    {"::oo::InfoObject::mixins",	InfoObjectMixinsCmd},
-    {"::oo::InfoObject::namespace",	InfoObjectNsCmd},
-    {"::oo::InfoObject::variables",	InfoObjectVariablesCmd},
-    {"::oo::InfoObject::vars",		InfoObjectVarsCmd},
-    {NULL, NULL}
-};
-
-/*
- * List of commands that are used to implement the [info class] subcommands.
- */
-
-static const struct NameProcMap infoClassCmds[] = {
-    {"::oo::InfoClass::call",		InfoClassCallCmd},
-    {"::oo::InfoClass::constructor",	InfoClassConstrCmd},
-    {"::oo::InfoClass::definition",	InfoClassDefnCmd},
-    {"::oo::InfoClass::destructor",	InfoClassDestrCmd},
-    {"::oo::InfoClass::filters",	InfoClassFiltersCmd},
-    {"::oo::InfoClass::forward",	InfoClassForwardCmd},
-    {"::oo::InfoClass::instances",	InfoClassInstancesCmd},
-    {"::oo::InfoClass::methods",	InfoClassMethodsCmd},
-    {"::oo::InfoClass::methodtype",	InfoClassMethodTypeCmd},
-    {"::oo::InfoClass::mixins",		InfoClassMixinsCmd},
-    {"::oo::InfoClass::subclasses",	InfoClassSubsCmd},
-    {"::oo::InfoClass::superclasses",	InfoClassSupersCmd},
-    {"::oo::InfoClass::variables",	InfoClassVariablesCmd},
-    {NULL, NULL}
-};
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOInitInfo --
- *
- *	Adjusts the Tcl core [info] command to contain subcommands ("object"
- *	and "class") for introspection of objects and classes.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOInitInfo(
-    Tcl_Interp *interp)
-{
-    Tcl_Namespace *nsPtr;
-    Tcl_Command infoCmd;
-    int i;
-
-    /*
-     * Build the ensemble used to implement [info object].
-     */
-
-    nsPtr = Tcl_CreateNamespace(interp, "::oo::InfoObject", NULL, NULL);
-    Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr, TCL_ENSEMBLE_PREFIX);
-    Tcl_Export(interp, nsPtr, "[a-z]*", 1);
-    for (i=0 ; infoObjectCmds[i].name!=NULL ; i++) {
-	Tcl_CreateObjCommand(interp, infoObjectCmds[i].name,
-		infoObjectCmds[i].proc, NULL, NULL);
-    }
-
-    /*
-     * Build the ensemble used to implement [info class].
-     */
-
-    nsPtr = Tcl_CreateNamespace(interp, "::oo::InfoClass", NULL, NULL);
-    Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr, TCL_ENSEMBLE_PREFIX);
-    Tcl_Export(interp, nsPtr, "[a-z]*", 1);
-    for (i=0 ; infoClassCmds[i].name!=NULL ; i++) {
-	Tcl_CreateObjCommand(interp, infoClassCmds[i].name,
-		infoClassCmds[i].proc, NULL, NULL);
-    }
-
-    /*
-     * Install into the master [info] ensemble.
-     */
-
-    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
-    if (infoCmd != NULL && Tcl_IsEnsemble(infoCmd)) {
-	Tcl_Obj *mapDict, *objectObj, *classObj;
-
-	Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
-	if (mapDict != NULL) {
-	    objectObj = Tcl_NewStringObj("object", -1);
-	    classObj = Tcl_NewStringObj("class", -1);
-
-	    Tcl_IncrRefCount(objectObj);
-	    Tcl_IncrRefCount(classObj);
-	    Tcl_DictObjPut(NULL, mapDict, objectObj,
-		    Tcl_NewStringObj("::oo::InfoObject", -1));
-	    Tcl_DictObjPut(NULL, mapDict, classObj,
-		    Tcl_NewStringObj("::oo::InfoClass", -1));
-	    Tcl_DecrRefCount(objectObj);
-	    Tcl_DecrRefCount(classObj);
-	    Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
-	}
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * GetClassFromObj --
- *
- *	How to correctly get a class from a Tcl_Obj. Just a wrapper round
- *	Tcl_GetObjectFromObj, but this is an idiom that was used heavily.
- *
- * ----------------------------------------------------------------------
- */
-
-static inline Class *
-GetClassFromObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr)
-{
-    Object *oPtr = (Object *) Tcl_GetObjectFromObj(interp, objPtr);
-
-    if (oPtr == NULL) {
-	return NULL;
-    }
-    if (oPtr->classPtr == NULL) {
-	Tcl_AppendResult(interp, "\"", TclGetString(objPtr),
-		"\" is not a class", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
-		TclGetString(objPtr), NULL);
-	return NULL;
-    }
-    return oPtr->classPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectClassCmd --
- *
- *	Implements [info object class $objName ?$className?]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectClassCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-
-    if (objc != 2 && objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName ?className?");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    if (objc == 2) {
-	Tcl_SetObjResult(interp,
-		TclOOObjectName(interp, oPtr->selfCls->thisPtr));
-	return TCL_OK;
-    } else {
-	Class *mixinPtr, *o2clsPtr;
-	int i;
-
-	o2clsPtr = GetClassFromObj(interp, objv[2]);
-	if (o2clsPtr == NULL) {
-	    return TCL_ERROR;
-	}
-
-	FOREACH(mixinPtr, oPtr->mixins) {
-	    if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
-		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
-		return TCL_OK;
-	    }
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(
-		TclOOIsReachable(o2clsPtr, oPtr->selfCls)));
-	return TCL_OK;
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectDefnCmd --
- *
- *	Implements [info object definition $objName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectDefnCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    Tcl_HashEntry *hPtr;
-    Proc *procPtr;
-    CompiledLocal *localPtr;
-    Tcl_Obj *resultObjs[2];
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    if (!oPtr->methodsPtr) {
-	goto unknownMethod;
-    }
-    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
-    if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
-		"\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
-    if (procPtr == NULL) {
-	Tcl_AppendResult(interp,
-		"definition not available for this kind of method", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-
-    resultObjs[0] = Tcl_NewObj();
-    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
-	    localPtr=localPtr->nextPtr) {
-	if (TclIsVarArgument(localPtr)) {
-	    Tcl_Obj *argObj;
-
-	    argObj = Tcl_NewObj();
-	    Tcl_ListObjAppendElement(NULL, argObj,
-		    Tcl_NewStringObj(localPtr->name, -1));
-	    if (localPtr->defValuePtr != NULL) {
-		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
-	    }
-	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
-	}
-    }
-    resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr));
-    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectFiltersCmd --
- *
- *	Implements [info object filters $objName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectFiltersCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    int i;
-    Tcl_Obj *filterObj, *resultObj;
-    Object *oPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    resultObj = Tcl_NewObj();
-
-    FOREACH(filterObj, oPtr->filters) {
-	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectForwardCmd --
- *
- *	Implements [info object forward $objName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectForwardCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    Tcl_HashEntry *hPtr;
-    Tcl_Obj *prefixObj;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    if (!oPtr->methodsPtr) {
-	goto unknownMethod;
-    }
-    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
-    if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
-		"\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
-    if (prefixObj == NULL) {
-	Tcl_AppendResult(interp,
-		"prefix argument list not available for this kind of method",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, prefixObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectIsACmd --
- *
- *	Implements [info object isa $category $objName ...]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectIsACmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    static const char *const categories[] = {
-	"class", "metaclass", "mixin", "object", "typeof", NULL
-    };
-    enum IsACats {
-	IsClass, IsMetaclass, IsMixin, IsObject, IsType
-    };
-    Object *oPtr, *o2Ptr;
-    int idx, i;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
-	    &idx) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    if (idx == IsObject) {
-	int ok = (Tcl_GetObjectFromObj(interp, objv[2]) != NULL);
-
-	if (!ok) {
-	    Tcl_ResetResult(interp);
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0));
-	return TCL_OK;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum IsACats) idx) {
-    case IsClass:
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "objName");
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0));
-	return TCL_OK;
-    case IsMetaclass:
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "objName");
-	    return TCL_ERROR;
-	}
-	if (oPtr->classPtr == NULL) {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
-	} else {
-	    Class *classCls = TclOOGetFoundation(interp)->classCls;
-
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(
-		    TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0));
-	}
-	return TCL_OK;
-    case IsMixin:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "objName className");
-	    return TCL_ERROR;
-	}
-	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
-	if (o2Ptr == NULL) {
-	    return TCL_ERROR;
-	}
-	if (o2Ptr->classPtr == NULL) {
-	    Tcl_AppendResult(interp, "non-classes cannot be mixins", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
-	    return TCL_ERROR;
-	} else {
-	    Class *mixinPtr;
-
-	    FOREACH(mixinPtr, oPtr->mixins) {
-		if (mixinPtr == o2Ptr->classPtr) {
-		    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
-		    return TCL_OK;
-		}
-	    }
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
-	return TCL_OK;
-    case IsType:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "objName className");
-	    return TCL_ERROR;
-	}
-	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
-	if (o2Ptr == NULL) {
-	    return TCL_ERROR;
-	}
-	if (o2Ptr->classPtr == NULL) {
-	    Tcl_AppendResult(interp, "non-classes cannot be types", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "NONCLASS", NULL);
-	    return TCL_ERROR;
-	}
-	if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
-	} else {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
-	}
-	return TCL_OK;
-    case IsObject:
-	Tcl_Panic("unexpected fallthrough");
-    }
-    return TCL_ERROR;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectMethodsCmd --
- *
- *	Implements [info object methods $objName ?$option ...?]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectMethodsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    int flag = PUBLIC_METHOD, recurse = 0;
-    FOREACH_HASH_DECLS;
-    Tcl_Obj *namePtr, *resultObj;
-    Method *mPtr;
-    static const char *const options[] = {
-	"-all", "-localprivate", "-private", NULL
-    };
-    enum Options {
-	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
-    };
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
-	return TCL_ERROR;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (objc != 2) {
-	int i, idx;
-
-	for (i=2 ; i<objc ; i++) {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
-		    &idx) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    switch ((enum Options) idx) {
-	    case OPT_ALL:
-		recurse = 1;
-		break;
-	    case OPT_LOCALPRIVATE:
-		flag = PRIVATE_METHOD;
-		break;
-	    case OPT_PRIVATE:
-		flag = 0;
-		break;
-	    }
-	}
-    }
-
-    resultObj = Tcl_NewObj();
-    if (recurse) {
-	const char **names;
-	int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
-
-	for (i=0 ; i<numNames ; i++) {
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(names[i], -1));
-	}
-	if (numNames > 0) {
-	    ckfree(names);
-	}
-    } else if (oPtr->methodsPtr) {
-	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
-	    if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
-		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
-	    }
-	}
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectMethodTypeCmd --
- *
- *	Implements [info object methodtype $objName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectMethodTypeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    Tcl_HashEntry *hPtr;
-    Method *mPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
-	return TCL_ERROR;
-    }
-
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    if (!oPtr->methodsPtr) {
-	goto unknownMethod;
-    }
-    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
-    if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
-		"\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-    mPtr = Tcl_GetHashValue(hPtr);
-    if (mPtr->typePtr == NULL) {
-	/*
-	 * Special entry for visibility control: pretend the method doesnt
-	 * exist.
-	 */
-
-	goto unknownMethod;
-    }
-
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectMixinsCmd --
- *
- *	Implements [info object mixins $objName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectMixinsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Class *mixinPtr;
-    Object *oPtr;
-    Tcl_Obj *resultObj;
-    int i;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName");
-	return TCL_ERROR;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(mixinPtr, oPtr->mixins) {
-	Tcl_ListObjAppendElement(NULL, resultObj,
-		TclOOObjectName(interp, mixinPtr->thisPtr));
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectNsCmd --
- *
- *	Implements [info object namespace $objName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectNsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName");
-	return TCL_ERROR;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp,
-	    Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectVariablesCmd --
- *
- *	Implements [info object variables $objName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectVariablesCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    Tcl_Obj *variableObj, *resultObj;
-    int i;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName");
-	return TCL_ERROR;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(variableObj, oPtr->variables) {
-	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectVarsCmd --
- *
- *	Implements [info object vars $objName ?$pattern?]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectVarsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    const char *pattern = NULL;
-    FOREACH_HASH_DECLS;
-    VarInHash *vihPtr;
-    Tcl_Obj *nameObj, *resultObj;
-
-    if (objc != 2 && objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName ?pattern?");
-	return TCL_ERROR;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (objc == 3) {
-	pattern = TclGetString(objv[2]);
-    }
-    resultObj = Tcl_NewObj();
-
-    /*
-     * Extract the information we need from the object's namespace's table of
-     * variables. Note that this involves horrific knowledge of the guts of
-     * tclVar.c, so we can't leverage our hash-iteration macros properly.
-     */
-
-    FOREACH_HASH_VALUE(vihPtr,
-	    &((Namespace *) oPtr->namespacePtr)->varTable.table) {
-	nameObj = vihPtr->entry.key.objPtr;
-
-	if (TclIsVarUndefined(&vihPtr->var)
-		|| !TclIsVarNamespaceVar(&vihPtr->var)) {
-	    continue;
-	}
-	if (pattern != NULL
-		&& !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
-	    continue;
-	}
-	Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
-    }
-
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassConstrCmd --
- *
- *	Implements [info class constructor $clsName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassConstrCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Proc *procPtr;
-    CompiledLocal *localPtr;
-    Tcl_Obj *resultObjs[2];
-    Class *clsPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (clsPtr->constructorPtr == NULL) {
-	return TCL_OK;
-    }
-    procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
-    if (procPtr == NULL) {
-	Tcl_AppendResult(interp,
-		"definition not available for this kind of method", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
-	return TCL_ERROR;
-    }
-
-    resultObjs[0] = Tcl_NewObj();
-    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
-	    localPtr=localPtr->nextPtr) {
-	if (TclIsVarArgument(localPtr)) {
-	    Tcl_Obj *argObj;
-
-	    argObj = Tcl_NewObj();
-	    Tcl_ListObjAppendElement(NULL, argObj,
-		    Tcl_NewStringObj(localPtr->name, -1));
-	    if (localPtr->defValuePtr != NULL) {
-		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
-	    }
-	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
-	}
-    }
-    resultObjs[1] = TclOOGetMethodBody(clsPtr->constructorPtr);
-    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassDefnCmd --
- *
- *	Implements [info class definition $clsName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassDefnCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_HashEntry *hPtr;
-    Proc *procPtr;
-    CompiledLocal *localPtr;
-    Tcl_Obj *resultObjs[2];
-    Class *clsPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
-    if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
-		"\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
-    if (procPtr == NULL) {
-	Tcl_AppendResult(interp,
-		"definition not available for this kind of method", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-
-    resultObjs[0] = Tcl_NewObj();
-    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
-	    localPtr=localPtr->nextPtr) {
-	if (TclIsVarArgument(localPtr)) {
-	    Tcl_Obj *argObj;
-
-	    argObj = Tcl_NewObj();
-	    Tcl_ListObjAppendElement(NULL, argObj,
-		    Tcl_NewStringObj(localPtr->name, -1));
-	    if (localPtr->defValuePtr != NULL) {
-		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
-	    }
-	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
-	}
-    }
-    resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr));
-    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassDestrCmd --
- *
- *	Implements [info class destructor $clsName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassDestrCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Proc *procPtr;
-    Class *clsPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    if (clsPtr->destructorPtr == NULL) {
-	return TCL_OK;
-    }
-    procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
-    if (procPtr == NULL) {
-	Tcl_AppendResult(interp,
-		"definition not available for this kind of method", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassFiltersCmd --
- *
- *	Implements [info class filters $clsName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassFiltersCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    int i;
-    Tcl_Obj *filterObj, *resultObj;
-    Class *clsPtr;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(filterObj, clsPtr->filters) {
-	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassForwardCmd --
- *
- *	Implements [info class forward $clsName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassForwardCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_HashEntry *hPtr;
-    Tcl_Obj *prefixObj;
-    Class *clsPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
-    if (hPtr == NULL) {
-	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
-		"\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
-    if (prefixObj == NULL) {
-	Tcl_AppendResult(interp,
-		"prefix argument list not available for this kind of method",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-
-    Tcl_SetObjResult(interp, prefixObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassInstancesCmd --
- *
- *	Implements [info class instances $clsName ?$pattern?]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassInstancesCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    Class *clsPtr;
-    int i;
-    const char *pattern = NULL;
-    Tcl_Obj *resultObj;
-
-    if (objc != 2 && objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (objc == 3) {
-	pattern = TclGetString(objv[2]);
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(oPtr, clsPtr->instances) {
-	Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr);
-
-	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
-	    continue;
-	}
-	Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassMethodsCmd --
- *
- *	Implements [info class methods $clsName ?-private?]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassMethodsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    int flag = PUBLIC_METHOD, recurse = 0;
-    Tcl_Obj *namePtr, *resultObj;
-    Method *mPtr;
-    Class *clsPtr;
-    static const char *const options[] = {
-	"-all", "-localprivate", "-private", NULL
-    };
-    enum Options {
-	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
-    };
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (objc != 2) {
-	int i, idx;
-
-	for (i=2 ; i<objc ; i++) {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
-		    &idx) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    switch ((enum Options) idx) {
-	    case OPT_ALL:
-		recurse = 1;
-		break;
-	    case OPT_LOCALPRIVATE:
-		flag = PRIVATE_METHOD;
-		break;
-	    case OPT_PRIVATE:
-		flag = 0;
-		break;
-	    }
-	}
-    }
-
-    resultObj = Tcl_NewObj();
-    if (recurse) {
-	const char **names;
-	int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);
-
-	for (i=0 ; i<numNames ; i++) {
-	    Tcl_ListObjAppendElement(NULL, resultObj,
-		    Tcl_NewStringObj(names[i], -1));
-	}
-	if (numNames > 0) {
-	    ckfree(names);
-	}
-    } else {
-	FOREACH_HASH_DECLS;
-
-	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
-	    if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
-		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
-	    }
-	}
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassMethodTypeCmd --
- *
- *	Implements [info class methodtype $clsName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassMethodTypeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_HashEntry *hPtr;
-    Method *mPtr;
-    Class *clsPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
-    if (hPtr == NULL) {
-    unknownMethod:
-	Tcl_AppendResult(interp, "unknown method \"", TclGetString(objv[2]),
-		"\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		TclGetString(objv[2]), NULL);
-	return TCL_ERROR;
-    }
-    mPtr = Tcl_GetHashValue(hPtr);
-    if (mPtr->typePtr == NULL) {
-	/*
-	 * Special entry for visibility control: pretend the method doesnt
-	 * exist.
-	 */
-
-	goto unknownMethod;
-    }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassMixinsCmd --
- *
- *	Implements [info class mixins $clsName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassMixinsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Class *clsPtr, *mixinPtr;
-    Tcl_Obj *resultObj;
-    int i;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(mixinPtr, clsPtr->mixins) {
-	Tcl_ListObjAppendElement(NULL, resultObj,
-		TclOOObjectName(interp, mixinPtr->thisPtr));
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassSubsCmd --
- *
- *	Implements [info class subclasses $clsName ?$pattern?]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassSubsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Class *clsPtr, *subclassPtr;
-    Tcl_Obj *resultObj;
-    int i;
-    const char *pattern = NULL;
-
-    if (objc != 2 && objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (objc == 3) {
-	pattern = TclGetString(objv[2]);
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(subclassPtr, clsPtr->subclasses) {
-	Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);
-
-	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
-	    continue;
-	}
-	Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
-    }
-    FOREACH(subclassPtr, clsPtr->mixinSubs) {
-	Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);
-
-	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
-	    continue;
-	}
-	Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassSupersCmd --
- *
- *	Implements [info class superclasses $clsName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassSupersCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Class *clsPtr, *superPtr;
-    Tcl_Obj *resultObj;
-    int i;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(superPtr, clsPtr->superclasses) {
-	Tcl_ListObjAppendElement(NULL, resultObj,
-		TclOOObjectName(interp, superPtr->thisPtr));
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassVariablesCmd --
- *
- *	Implements [info class variables $clsName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassVariablesCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Class *clsPtr;
-    Tcl_Obj *variableObj, *resultObj;
-    int i;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    resultObj = Tcl_NewObj();
-    FOREACH(variableObj, clsPtr->variables) {
-	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoObjectCallCmd --
- *
- *	Implements [info object call $objName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoObjectCallCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Object *oPtr;
-    CallContext *contextPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
-	return TCL_ERROR;
-    }
-    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get the call context and render its call chain.
-     */
-
-    contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
-    if (contextPtr == NULL) {
-	Tcl_AppendResult(interp, "cannot construct any call chain", NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp,
-	    TclOORenderCallChain(interp, contextPtr->callPtr));
-    TclOODeleteContext(contextPtr);
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InfoClassCallCmd --
- *
- *	Implements [info class call $clsName $methodName]
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InfoClassCallCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Class *clsPtr;
-    CallChain *callPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
-	return TCL_ERROR;
-    }
-    clsPtr = GetClassFromObj(interp, objv[1]);
-    if (clsPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get an render the stereotypical call chain.
-     */
-
-    callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD);
-    if (callPtr == NULL) {
-	Tcl_AppendResult(interp, "cannot construct any call chain", NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
-    TclOODeleteChain(callPtr);
-    return TCL_OK;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
deleted file mode 100644
index 7988452..0000000
--- a/generic/tclOOInt.h
+++ /dev/null
@@ -1,611 +0,0 @@
-/*
- * tclOOInt.h --
- *
- *	This file contains the structure definitions and some of the function
- *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
- *
- * Copyright (c) 2006-2011 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.
- */
-
-#ifndef TCL_OO_INTERNAL_H
-#define TCL_OO_INTERNAL_H 1
-
-#include "tclInt.h"
-#include "tclOO.h"
-
-/*
- * Hack to make things work with Objective C. Note that ObjC isn't really
- * supported, but we don't want to to be actively hostile to it. [Bug 2163447]
- */
-
-#ifdef __OBJC__
-#define Class	TclOOClass
-#define Object	TclOOObject
-#endif /* __OBJC__ */
-
-/*
- * Forward declarations.
- */
-
-struct CallChain;
-struct Class;
-struct Foundation;
-struct Object;
-
-/*
- * The data that needs to be stored per method. This record is used to collect
- * information about all sorts of methods, including forwards, constructors
- * and destructors.
- */
-
-typedef struct Method {
-    const Tcl_MethodType *typePtr;
-				/* The type of method. If NULL, this is a
-				 * special flag record which is just used for
-				 * the setting of the flags field. */
-    int refCount;
-    ClientData clientData;	/* Type-specific data. */
-    Tcl_Obj *namePtr;		/* Name of the method. */
-    struct Object *declaringObjectPtr;
-				/* The object that declares this method, or
-				 * NULL if it was declared by a class. */
-    struct Class *declaringClassPtr;
-				/* The class that declares this method, or
-				 * NULL if it was declared directly on an
-				 * object. */
-    int flags;			/* Assorted flags. Includes whether this
-				 * method is public/exported or not. */
-} Method;
-
-/*
- * Pre- and post-call callbacks, to allow procedure-like methods to be fine
- * tuned in their behaviour.
- */
-
-typedef int (TclOO_PreCallProc)(ClientData clientData, Tcl_Interp *interp,
-	Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
-typedef int (TclOO_PostCallProc)(ClientData clientData, Tcl_Interp *interp,
-	Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
-typedef void (TclOO_PmCDDeleteProc)(ClientData clientData);
-typedef ClientData (TclOO_PmCDCloneProc)(ClientData clientData);
-
-/*
- * Procedure-like methods have the following extra information.
- */
-
-typedef struct ProcedureMethod {
-    int version;		/* Version of this structure. Currently must
-				 * be 0. */
-    Proc *procPtr;		/* Core of the implementation of the method;
-				 * includes the argument definition and the
-				 * body bytecodes. */
-    int flags;			/* Flags to control features. */
-    int refCount;
-    ClientData clientData;
-    TclOO_PmCDDeleteProc *deleteClientdataProc;
-    TclOO_PmCDCloneProc *cloneClientdataProc;
-    ProcErrorProc *errProc;	/* Replacement error handler. */
-    TclOO_PreCallProc *preCallProc;
-				/* Callback to allow for additional setup
-				 * before the method executes. */
-    TclOO_PostCallProc *postCallProc;
-				/* Callback to allow for additional cleanup
-				 * after the method executes. */
-    GetFrameInfoValueProc *gfivProc;
-				/* Callback to allow for fine tuning of how
-				 * the method reports itself. */
-} ProcedureMethod;
-
-#define TCLOO_PROCEDURE_METHOD_VERSION 0
-
-/*
- * Flags for use in a ProcedureMethod.
- *
- * When the USE_DECLARER_NS flag is set, the method will use the namespace of
- * the object or class that declared it (or the clone of it, if it was from
- * such that the implementation of the method came to the particular use)
- * instead of the namespace of the object on which the method was invoked.
- * This flag must be distinct from all others that are associated with
- * methods.
- */
-
-#define USE_DECLARER_NS		0x80
-
-/*
- * Forwarded methods have the following extra information.
- */
-
-typedef struct ForwardMethod {
-    Tcl_Obj *prefixObj;		/* The list of values to use to replace the
-				 * object and method name with. Will be a
-				 * non-empty list. */
-    int fullyQualified;		/* If 1, the command name is fully qualified
-				 * and we should let the default Tcl mechanism
-				 * handle the command lookup because it is
-				 * more efficient. If 0, we need to do a
-				 * specialized lookup based on the current
-				 * object's namespace. */
-} ForwardMethod;
-
-/*
- * Helper definitions that declare a "list" array. The two varieties are
- * either optimized for simplicity (in the case that the whole array is
- * typically assigned at once) or efficiency (in the case that the array is
- * expected to be expanded over time). These lists are designed to be iterated
- * over with the help of the FOREACH macro (see later in this file).
- *
- * The "num" field always counts the number of listType_t elements used in the
- * "list" field. When a "size" field exists, it describes how many elements
- * are present in the list; when absent, exactly "num" elements are present.
- */
-
-#define LIST_STATIC(listType_t) \
-    struct { int num; listType_t *list; }
-#define LIST_DYNAMIC(listType_t) \
-    struct { int num, size; listType_t *list; }
-
-/*
- * Now, the definition of what an object actually is.
- */
-
-typedef struct Object {
-    struct Foundation *fPtr;	/* The basis for the object system. Putting
-				 * this here allows the avoidance of quite a
-				 * lot of hash lookups on the critical path
-				 * for object invokation and creation. */
-    Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
-    Tcl_Command command;	/* Reference to this object's public
-				 * command. */
-    Tcl_Command myCommand;	/* Reference to this object's internal
-				 * command. */
-    struct Class *selfCls;	/* This object's class. */
-    Tcl_HashTable *methodsPtr;	/* Object-local Tcl_Obj (method name) to
-				 * Method* mapping. */
-    LIST_STATIC(struct Class *) mixins;
-				/* Classes mixed into this object. */
-    LIST_STATIC(Tcl_Obj *) filters;
-				/* List of filter names. */
-    struct Class *classPtr;	/* All classes have this non-NULL; it points
-				 * to the class structure. Everything else has
-				 * this NULL. */
-    int refCount;		/* Number of strong references to this object.
-				 * Note that there may be many more weak
-				 * references; this mechanism is there to
-				 * avoid Tcl_Preserve. */
-    int flags;
-    int creationEpoch;		/* Unique value to make comparisons of objects
-				 * easier. */
-    int epoch;			/* Per-object epoch, incremented when the way
-				 * an object should resolve call chains is
-				 * changed. */
-    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
-				 * the ClientData values that are the values
-				 * of each piece of attached metadata. This
-				 * field starts out as NULL and is only
-				 * allocated if metadata is attached. */
-    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
-    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
-				 * is indexed by method name as Tcl_Obj. */
-    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
-				/* Function to allow remapping of method
-				 * names. For itcl-ng. */
-    LIST_STATIC(Tcl_Obj *) variables;
-} Object;
-
-#define OBJECT_DELETED	1	/* Flag to say that an object has been
-				 * destroyed. */
-#define DESTRUCTOR_CALLED 2	/* Flag to say that the destructor has been
-				 * called. */
-#define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
-				 * the class hierarchy and should be treated
-				 * specially during teardown. */
-#define FILTER_HANDLING 0x2000	/* Flag set when the object is processing a
-				 * filter; when set, filters are *not*
-				 * processed on the object, preventing nasty
-				 * recursive filtering problems. */
-#define USE_CLASS_CACHE 0x4000	/* Flag set to say that the object is a pure
-				 * instance of the class, and has had nothing
-				 * added that changes the dispatch chain (i.e.
-				 * no methods, mixins, or filters. */
-#define ROOT_CLASS 0x8000	/* Flag to say that this object is the root
-				 * class of classes, and should be treated
-				 * specially during teardown (and in a few
-				 * other spots). */
-#define FORCE_UNKNOWN 0x10000	/* States that we are *really* looking up the
-				 * unknown method handler at that point. */
-
-/*
- * And the definition of a class. Note that every class also has an associated
- * object, through which it is manipulated.
- */
-
-typedef struct Class {
-    Object *thisPtr;		/* Reference to the object associated with
-				 * this class. */
-    int refCount;		/* Number of strong references to this class.
-				 * Weak references are not counted; the
-				 * purpose of this is to avoid Tcl_Preserve as
-				 * that is quite slow. */
-    int flags;			/* Assorted flags. */
-    LIST_STATIC(struct Class *) superclasses;
-				/* List of superclasses, used for generation
-				 * of method call chains. */
-    LIST_DYNAMIC(struct Class *) subclasses;
-				/* List of subclasses, used to ensure deletion
-				 * of dependent entities happens properly when
-				 * the class itself is deleted. */
-    LIST_DYNAMIC(Object *) instances;
-				/* List of instances, used to ensure deletion
-				 * of dependent entities happens properly when
-				 * the class itself is deleted. */
-    LIST_STATIC(Tcl_Obj *) filters;
-				/* List of filter names, used for generation
-				 * of method call chains. */
-    LIST_STATIC(struct Class *) mixins;
-				/* List of mixin classes, used for generation
-				 * of method call chains. */
-    LIST_DYNAMIC(struct Class *) mixinSubs;
-				/* List of classes that this class is mixed
-				 * into, used to ensure deletion of dependent
-				 * entities happens properly when the class
-				 * itself is deleted. */
-    Tcl_HashTable classMethods;	/* Hash table of all methods. Hash maps from
-				 * the (Tcl_Obj*) method name to the (Method*)
-				 * method record. */
-    Method *constructorPtr;	/* Method record of the class constructor (if
-				 * any). */
-    Method *destructorPtr;	/* Method record of the class destructor (if
-				 * any). */
-    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
-				 * the ClientData values that are the values
-				 * of each piece of attached metadata. This
-				 * field starts out as NULL and is only
-				 * allocated if metadata is attached. */
-    struct CallChain *constructorChainPtr;
-    struct CallChain *destructorChainPtr;
-    Tcl_HashTable *classChainCache;
-				/* Places where call chains are stored. For
-				 * constructors, the class chain is always
-				 * used. For destructors and ordinary methods,
-				 * the class chain is only used when the
-				 * object doesn't override with its own mixins
-				 * (and filters and method implementations for
-				 * when getting method chains). */
-    LIST_STATIC(Tcl_Obj *) variables;
-} Class;
-
-/*
- * The foundation of the object system within an interpreter contains
- * references to the key classes and namespaces, together with a few other
- * useful bits and pieces. Probably ought to eventually go in the Interp
- * structure itself.
- */
-
-typedef struct ThreadLocalData {
-    int nsCount;		/* Master epoch counter is used for keeping
-				 * the values used in Tcl_Obj internal
-				 * representations sane. Must be thread-local
-				 * because Tcl_Objs can cross interpreter
-				 * boundaries within a thread (objects don't
-				 * generally cross threads). */
-} ThreadLocalData;
-
-typedef struct Foundation {
-    Tcl_Interp *interp;
-    Class *objectCls;		/* The root of the object system. */
-    Class *classCls;		/* The class of all classes. */
-    Tcl_Namespace *ooNs;	/* Master ::oo namespace. */
-    Tcl_Namespace *defineNs;	/* Namespace containing special commands for
-				 * manipulating objects and classes. The
-				 * "oo::define" command acts as a special kind
-				 * of ensemble for this namespace. */
-    Tcl_Namespace *objdefNs;	/* Namespace containing special commands for
-				 * manipulating objects and classes. The
-				 * "oo::objdefine" command acts as a special
-				 * kind of ensemble for this namespace. */
-    Tcl_Namespace *helpersNs;	/* Namespace containing the commands that are
-				 * only valid when executing inside a
-				 * procedural method. */
-    int epoch;			/* Used to invalidate method chains when the
-				 * class structure changes. */
-    ThreadLocalData *tsdPtr;	/* Counter so we can allocate a unique
-				 * namespace to each object. */
-    Tcl_Obj *unknownMethodNameObj;
-				/* Shared object containing the name of the
-				 * unknown method handler method. */
-    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a
-				 * constructor. */
-    Tcl_Obj *destructorName;	/* Shared object containing the "name" of a
-				 * destructor. */
-    Tcl_Obj *clonedName;	/* Shared object containing the name of a
-				 * "<cloned>" pseudo-constructor. */
-} Foundation;
-
-/*
- * A call context structure is built when a method is called. They contain the
- * chain of method implementations that are to be invoked by a particular
- * call, and the process of calling walks the chain, with the [next] command
- * proceeding to the next entry in the chain.
- */
-
-#define CALL_CHAIN_STATIC_SIZE 4
-
-struct MInvoke {
-    Method *mPtr;		/* Reference to the method implementation
-				 * record. */
-    int isFilter;		/* Whether this is a filter invokation. */
-    Class *filterDeclarer;	/* What class decided to add the filter; if
-				 * NULL, it was added by the object. */
-};
-
-typedef struct CallChain {
-    int objectCreationEpoch;	/* The object's creation epoch. Note that the
-				 * object reference is not stored in the call
-				 * chain; it is in the call context. */
-    int objectEpoch;		/* Local (object structure) epoch counter
-				 * snapshot. */
-    int epoch;			/* Global (class structure) epoch counter
-				 * snapshot. */
-    int flags;			/* Assorted flags, see below. */
-    int refCount;		/* Reference count. */
-    int numChain;		/* Size of the call chain. */
-    struct MInvoke *chain;	/* Array of call chain entries. May point to
-				 * staticChain if the number of entries is
-				 * small. */
-    struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
-} CallChain;
-
-typedef struct CallContext {
-    Object *oPtr;		/* The object associated with this call. */
-    int index;			/* Index into the call chain of the currently
-				 * executing method implementation. */
-    int skip;			/* Current number of arguments to skip; can
-				 * vary depending on whether it is a direct
-				 * method call or a continuation via the
-				 * [next] command. */
-    CallChain *callPtr;		/* The actual call chain. */
-} CallContext;
-
-/*
- * Bits for the 'flags' field of the call chain.
- */
-
-#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
-#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
-				 * only) method. */
-#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
-#define CONSTRUCTOR	  0x08	/* This is a constructor. */
-#define DESTRUCTOR	  0x10	/* This is a destructor. */
-
-/*
- * Structure containing definition information about basic class methods.
- */
-
-typedef struct {
-    const char *name;		/* Name of the method in question. */
-    int isPublic;		/* Whether the method is public by default. */
-    Tcl_MethodType definition;	/* How to call the method. */
-} DeclaredClassMethod;
-
-/*
- *----------------------------------------------------------------
- * Commands relating to OO support.
- *----------------------------------------------------------------
- */
-
-MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
-MODULE_SCOPE int	TclOODefineObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOOObjDefObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineConstructorObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineDeleteMethodObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineDestructorObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineExportObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineForwardObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineMethodObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineUnexportObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOONextObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOONextToObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOOSelfObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
-
-/*
- * Method implementations (in tclOOBasic.c).
- */
-
-MODULE_SCOPE int	TclOO_Class_Create(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOO_Class_CreateNs(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOO_Class_New(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOO_Object_Destroy(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOO_Object_Eval(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOO_Object_LinkVar(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOO_Object_Unknown(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-MODULE_SCOPE int	TclOO_Object_VarName(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-
-/*
- * Private definitions, some of which perhaps ought to be exposed properly or
- * maybe just put in the internal stubs table.
- */
-
-MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
-MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
-MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
-MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
-			    Tcl_Class cls, const char *nameStr,
-			    const char *nsNameStr, int objc,
-			    Tcl_Obj *const *objv, int skip,
-			    Tcl_Object *objectPtr);
-MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
-MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
-MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
-MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
-MODULE_SCOPE void	TclOODelMethodRef(Method *method);
-MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
-			    Tcl_Obj *methodNameObj, int flags,
-			    Tcl_Obj *cacheInThisObj);
-MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
-			    Tcl_Obj *methodNameObj, int flags);
-MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
-MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
-MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
-MODULE_SCOPE Tcl_Obj *	TclOOGetMethodBody(Method *mPtr);
-MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,
-			    int flags, const char ***stringsPtr);
-MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr, int flags,
-			    const char ***stringsPtr);
-MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
-MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
-MODULE_SCOPE int	TclOOInvokeContext(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
-			    Tcl_ObjectContext context, int objc,
-			    Tcl_Obj *const *objv, int skip);
-MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
-			    const DeclaredClassMethod *dcm);
-MODULE_SCOPE int	TclOONRUpcatch(ClientData ignored, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
-MODULE_SCOPE void	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
-MODULE_SCOPE void	TclOORemoveFromMixinSubs(Class *subPtr,
-			    Class *mixinPtr);
-MODULE_SCOPE void	TclOORemoveFromSubclasses(Class *subPtr,
-			    Class *superPtr);
-MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
-			    CallChain *callPtr);
-MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,
-			    CallContext *contextPtr);
-MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
-MODULE_SCOPE int	TclOOUpcatchCmd(ClientData ignored,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-
-/*
- * Include all the private API, generated from tclOO.decls.
- */
-
-#include "tclOOIntDecls.h"
-
-/*
- * A convenience macro for iterating through the lists used in the internal
- * memory management of objects. This is a bit gnarly because we want to do
- * the assignment of the picked-out value only when the body test succeeds,
- * but we cannot rely on the assigned value being useful, forcing us to do
- * some nasty stuff with the comma operator. The compiler's optimizer should
- * be able to sort it all out!
- *
- * REQUIRES DECLARATION: int i;
- */
-
-#define FOREACH(var,ary) \
-	for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)
-
-/*
- * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
- * sets up the declarations needed for the main macro, FOREACH_HASH, which
- * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
- * only iterates over values.
- */
-
-#define FOREACH_HASH_DECLS \
-    Tcl_HashEntry *hPtr;Tcl_HashSearch search
-#define FOREACH_HASH(key,val,tablePtr) \
-    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
-	    ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
-	    (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
-#define FOREACH_HASH_VALUE(val,tablePtr) \
-    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
-	    ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
-
-/*
- * Convenience macro for duplicating a list. Needs no external declaration,
- * but all arguments are used multiple times and so must have no side effects.
- */
-
-#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
-#define DUPLICATE(target,source,type) \
-    do { \
-	register unsigned len = sizeof(type) * ((target).num=(source).num);\
-	if (len != 0) { \
-	    memcpy(((target).list=(type*)ckalloc(len)), (source).list, len); \
-	} else { \
-	    (target).list = NULL; \
-	} \
-    } while(0)
-
-/*
- * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
- */
-
-#define AddRef(ptr) ((ptr)->refCount++)
-#define DelRef(ptr) do {			\
-	if (--(ptr)->refCount < 1) {		\
-	    ckfree((char *) (ptr));		\
-	}					\
-    } while(0)
-
-#endif /* TCL_OO_INTERNAL_H */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h
deleted file mode 100644
index c751838..0000000
--- a/generic/tclOOIntDecls.h
+++ /dev/null
@@ -1,163 +0,0 @@
-/*
- * This file is (mostly) automatically generated from tclOO.decls.
- */
-
-#ifndef _TCLOOINTDECLS
-#define _TCLOOINTDECLS
-
-/* !BEGIN!: Do not edit below this line. */
-
-/*
- * Exported function declarations:
- */
-
-/* 0 */
-TCLOOAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
-/* 1 */
-TCLOOAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
-				Object *oPtr, int flags, Tcl_Obj *nameObj,
-				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-				const Tcl_MethodType *typePtr,
-				ClientData clientData, Proc **procPtrPtr);
-/* 2 */
-TCLOOAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
-				Class *clsPtr, int flags, Tcl_Obj *nameObj,
-				const char *namePtr, Tcl_Obj *argsObj,
-				Tcl_Obj *bodyObj,
-				const Tcl_MethodType *typePtr,
-				ClientData clientData, Proc **procPtrPtr);
-/* 3 */
-TCLOOAPI Method *	TclOONewProcInstanceMethod(Tcl_Interp *interp,
-				Object *oPtr, int flags, Tcl_Obj *nameObj,
-				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-				ProcedureMethod **pmPtrPtr);
-/* 4 */
-TCLOOAPI Method *	TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
-				int flags, Tcl_Obj *nameObj,
-				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-				ProcedureMethod **pmPtrPtr);
-/* 5 */
-TCLOOAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
-				int objc, Tcl_Obj *const *objv,
-				int publicOnly, Class *startCls);
-/* 6 */
-TCLOOAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
-/* 7 */
-TCLOOAPI Method *	TclOONewForwardMethod(Tcl_Interp *interp,
-				Class *clsPtr, int isPublic,
-				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
-/* 8 */
-TCLOOAPI Method *	TclOONewForwardInstanceMethod(Tcl_Interp *interp,
-				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
-				Tcl_Obj *prefixObj);
-/* 9 */
-TCLOOAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
-				Tcl_Object oPtr,
-				TclOO_PreCallProc *preCallPtr,
-				TclOO_PostCallProc *postCallPtr,
-				ProcErrorProc *errProc,
-				ClientData clientData, Tcl_Obj *nameObj,
-				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-				int flags, void **internalTokenPtr);
-/* 10 */
-TCLOOAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
-				Tcl_Class clsPtr,
-				TclOO_PreCallProc *preCallPtr,
-				TclOO_PostCallProc *postCallPtr,
-				ProcErrorProc *errProc,
-				ClientData clientData, Tcl_Obj *nameObj,
-				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
-				int flags, void **internalTokenPtr);
-/* 11 */
-TCLOOAPI int		TclOOInvokeObject(Tcl_Interp *interp,
-				Tcl_Object object, Tcl_Class startCls,
-				int publicPrivate, int objc,
-				Tcl_Obj *const *objv);
-/* 12 */
-TCLOOAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
-				Tcl_Obj *const *filters);
-/* 13 */
-TCLOOAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
-				Class *classPtr, int numFilters,
-				Tcl_Obj *const *filters);
-/* 14 */
-TCLOOAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
-				Class *const *mixins);
-/* 15 */
-TCLOOAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
-				Class *classPtr, int numMixins,
-				Class *const *mixins);
-
-typedef struct TclOOIntStubs {
-    int magic;
-    const struct TclOOIntStubHooks *hooks;
-
-    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
-    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 1 */
-    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */
-    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
-    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
-    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
-    int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
-    Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
-    Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
-    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
-    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, ClientData clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
-    int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */
-    void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */
-    void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */
-    void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */
-    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
-} TclOOIntStubs;
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern const TclOOIntStubs *tclOOIntStubsPtr;
-#ifdef __cplusplus
-}
-#endif
-
-#if defined(USE_TCLOO_STUBS)
-
-/*
- * Inline function declarations:
- */
-
-#define TclOOGetDefineCmdContext \
-	(tclOOIntStubsPtr->tclOOGetDefineCmdContext) /* 0 */
-#define TclOOMakeProcInstanceMethod \
-	(tclOOIntStubsPtr->tclOOMakeProcInstanceMethod) /* 1 */
-#define TclOOMakeProcMethod \
-	(tclOOIntStubsPtr->tclOOMakeProcMethod) /* 2 */
-#define TclOONewProcInstanceMethod \
-	(tclOOIntStubsPtr->tclOONewProcInstanceMethod) /* 3 */
-#define TclOONewProcMethod \
-	(tclOOIntStubsPtr->tclOONewProcMethod) /* 4 */
-#define TclOOObjectCmdCore \
-	(tclOOIntStubsPtr->tclOOObjectCmdCore) /* 5 */
-#define TclOOIsReachable \
-	(tclOOIntStubsPtr->tclOOIsReachable) /* 6 */
-#define TclOONewForwardMethod \
-	(tclOOIntStubsPtr->tclOONewForwardMethod) /* 7 */
-#define TclOONewForwardInstanceMethod \
-	(tclOOIntStubsPtr->tclOONewForwardInstanceMethod) /* 8 */
-#define TclOONewProcInstanceMethodEx \
-	(tclOOIntStubsPtr->tclOONewProcInstanceMethodEx) /* 9 */
-#define TclOONewProcMethodEx \
-	(tclOOIntStubsPtr->tclOONewProcMethodEx) /* 10 */
-#define TclOOInvokeObject \
-	(tclOOIntStubsPtr->tclOOInvokeObject) /* 11 */
-#define TclOOObjectSetFilters \
-	(tclOOIntStubsPtr->tclOOObjectSetFilters) /* 12 */
-#define TclOOClassSetFilters \
-	(tclOOIntStubsPtr->tclOOClassSetFilters) /* 13 */
-#define TclOOObjectSetMixins \
-	(tclOOIntStubsPtr->tclOOObjectSetMixins) /* 14 */
-#define TclOOClassSetMixins \
-	(tclOOIntStubsPtr->tclOOClassSetMixins) /* 15 */
-
-#endif /* defined(USE_TCLOO_STUBS) */
-
-/* !END!: Do not edit above this line. */
-#endif /* _TCLOOINTDECLS */
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
deleted file mode 100644
index 4e7edb8..0000000
--- a/generic/tclOOMethod.c
+++ /dev/null
@@ -1,1755 +0,0 @@
-/*
- * tclOOMethod.c --
- *
- *	This file contains code to create and manage methods.
- *
- * Copyright (c) 2005-2008 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.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "tclInt.h"
-#include "tclOOInt.h"
-#include "tclCompile.h"
-
-/*
- * Structure used to help delay computing names of objects or classes for
- * [info frame] until needed, making invokation faster in the normal case.
- */
-
-struct PNI {
-    Tcl_Interp *interp;		/* Interpreter in which to compute the name of
-				 * a method. */
-    Tcl_Method method;		/* Method to compute the name of. */
-};
-
-/*
- * Structure used to contain all the information needed about a call frame
- * used in a procedure-like method.
- */
-
-typedef struct {
-    CallFrame *framePtr;	/* Reference to the call frame itself (it's
-				 * actually allocated on the Tcl stack). */
-    ProcErrorProc *errProc;	/* The error handler for the body. */
-    Tcl_Obj *nameObj;		/* The "name" of the command. */
-    Command cmd;		/* The command structure. Mostly bogus. */
-    ExtraFrameInfo efi;		/* Extra information used for [info frame]. */
-    Command *oldCmdPtr;		/* Saved cmdPtr so that we can be safe after a
-				 * recursive call returns. */
-    struct PNI pni;		/* Specialist information used in the efi
-				 * field for this type of call. */
-} PMFrameData;
-
-/*
- * Structure used to pass information about variable resolution to the
- * on-the-ground resolvers used when working with resolved compiled variables.
- */
-
-typedef struct {
-    Tcl_ResolvedVarInfo info;	/* "Type" information so that the compiled
-				 * variable can be linked to the namespace
-				 * variable at the right time. */
-    Tcl_Obj *variableObj;	/* The name of the variable. */
-    Tcl_Var cachedObjectVar;	/* TODO: When to flush this cache? Can class
-				 * variables be cached? */
-} OOResVarInfo;
-
-/*
- * Function declarations for things defined in this file.
- */
-
-static Tcl_Obj **	InitEnsembleRewrite(Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv, int toRewrite,
-			    int rewriteLength, Tcl_Obj *const *rewriteObjs,
-			    int *lengthPtr);
-static int		InvokeProcedureMethod(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static int		FinalizeForwardCall(ClientData data[], Tcl_Interp *interp,
-			    int result);
-static int		FinalizePMCall(ClientData data[], Tcl_Interp *interp,
-			    int result);
-static int		PushMethodCallFrame(Tcl_Interp *interp,
-			    CallContext *contextPtr, ProcedureMethod *pmPtr,
-			    int objc, Tcl_Obj *const *objv,
-			    PMFrameData *fdPtr);
-static void		DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
-static void		DeleteProcedureMethod(ClientData clientData);
-static int		CloneProcedureMethod(Tcl_Interp *interp,
-			    ClientData clientData, ClientData *newClientData);
-static void		MethodErrorHandler(Tcl_Interp *interp,
-			    Tcl_Obj *procNameObj);
-static void		ConstructorErrorHandler(Tcl_Interp *interp,
-			    Tcl_Obj *procNameObj);
-static void		DestructorErrorHandler(Tcl_Interp *interp,
-			    Tcl_Obj *procNameObj);
-static Tcl_Obj *	RenderDeclarerName(ClientData clientData);
-static int		InvokeForwardMethod(ClientData clientData,
-			    Tcl_Interp *interp, Tcl_ObjectContext context,
-			    int objc, Tcl_Obj *const *objv);
-static void		DeleteForwardMethod(ClientData clientData);
-static int		CloneForwardMethod(Tcl_Interp *interp,
-			    ClientData clientData, ClientData *newClientData);
-static int		ProcedureMethodVarResolver(Tcl_Interp *interp,
-			    const char *varName, Tcl_Namespace *contextNs,
-			    int flags, Tcl_Var *varPtr);
-static int		ProcedureMethodCompiledVarResolver(Tcl_Interp *interp,
-			    const char *varName, int length,
-			    Tcl_Namespace *contextNs,
-			    Tcl_ResolvedVarInfo **rPtrPtr);
-
-/*
- * The types of methods defined by the core OO system.
- */
-
-static const Tcl_MethodType procMethodType = {
-    TCL_OO_METHOD_VERSION_CURRENT, "method",
-    InvokeProcedureMethod, DeleteProcedureMethod, CloneProcedureMethod
-};
-static const Tcl_MethodType fwdMethodType = {
-    TCL_OO_METHOD_VERSION_CURRENT, "forward",
-    InvokeForwardMethod, DeleteForwardMethod, CloneForwardMethod
-};
-
-/*
- * Helper macros (derived from things private to tclVar.c)
- */
-
-#define TclVarTable(contextNs) \
-    ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
-#define TclVarHashGetValue(hPtr) \
-    ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry)))
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_NewInstanceMethod --
- *
- *	Attach a method to an object instance.
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Method
-Tcl_NewInstanceMethod(
-    Tcl_Interp *interp,		/* Unused? */
-    Tcl_Object object,		/* The object that has the method attached to
-				 * it. */
-    Tcl_Obj *nameObj,		/* The name of the method. May be NULL; if so,
-				 * up to caller to manage storage (e.g., when
-				 * it is a constructor or destructor). */
-    int flags,			/* Whether this is a public method. */
-    const Tcl_MethodType *typePtr,
-				/* The type of method this is, which defines
-				 * how to invoke, delete and clone the
-				 * method. */
-    ClientData clientData)	/* Some data associated with the particular
-				 * method to be created. */
-{
-    register Object *oPtr = (Object *) object;
-    register Method *mPtr;
-    Tcl_HashEntry *hPtr;
-    int isNew;
-
-    if (nameObj == NULL) {
-	mPtr = ckalloc(sizeof(Method));
-	mPtr->namePtr = NULL;
-	mPtr->refCount = 1;
-	goto populate;
-    }
-    if (!oPtr->methodsPtr) {
-	oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_InitObjHashTable(oPtr->methodsPtr);
-	oPtr->flags &= ~USE_CLASS_CACHE;
-    }
-    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
-    if (isNew) {
-	mPtr = ckalloc(sizeof(Method));
-	mPtr->namePtr = nameObj;
-	mPtr->refCount = 1;
-	Tcl_IncrRefCount(nameObj);
-	Tcl_SetHashValue(hPtr, mPtr);
-    } else {
-	mPtr = Tcl_GetHashValue(hPtr);
-	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
-	    mPtr->typePtr->deleteProc(mPtr->clientData);
-	}
-    }
-
-  populate:
-    mPtr->typePtr = typePtr;
-    mPtr->clientData = clientData;
-    mPtr->flags = 0;
-    mPtr->declaringObjectPtr = oPtr;
-    mPtr->declaringClassPtr = NULL;
-    if (flags) {
-	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
-    }
-    oPtr->epoch++;
-    return (Tcl_Method) mPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * Tcl_NewMethod --
- *
- *	Attach a method to a class.
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Method
-Tcl_NewMethod(
-    Tcl_Interp *interp,		/* The interpreter containing the class. */
-    Tcl_Class cls,		/* The class to attach the method to. */
-    Tcl_Obj *nameObj,		/* The name of the object. May be NULL (e.g.,
-				 * for constructors or destructors); if so, up
-				 * to caller to manage storage. */
-    int flags,			/* Whether this is a public method. */
-    const Tcl_MethodType *typePtr,
-				/* The type of method this is, which defines
-				 * how to invoke, delete and clone the
-				 * method. */
-    ClientData clientData)	/* Some data associated with the particular
-				 * method to be created. */
-{
-    register Class *clsPtr = (Class *) cls;
-    register Method *mPtr;
-    Tcl_HashEntry *hPtr;
-    int isNew;
-
-    if (nameObj == NULL) {
-	mPtr = ckalloc(sizeof(Method));
-	mPtr->namePtr = NULL;
-	mPtr->refCount = 1;
-	goto populate;
-    }
-    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
-    if (isNew) {
-	mPtr = ckalloc(sizeof(Method));
-	mPtr->refCount = 1;
-	mPtr->namePtr = nameObj;
-	Tcl_IncrRefCount(nameObj);
-	Tcl_SetHashValue(hPtr, mPtr);
-    } else {
-	mPtr = Tcl_GetHashValue(hPtr);
-	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
-	    mPtr->typePtr->deleteProc(mPtr->clientData);
-	}
-    }
-
-  populate:
-    clsPtr->thisPtr->fPtr->epoch++;
-    mPtr->typePtr = typePtr;
-    mPtr->clientData = clientData;
-    mPtr->flags = 0;
-    mPtr->declaringObjectPtr = NULL;
-    mPtr->declaringClassPtr = clsPtr;
-    if (flags) {
-	mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
-    }
-
-    return (Tcl_Method) mPtr;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOODelMethodRef --
- *
- *	How to delete a method.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOODelMethodRef(
-    Method *mPtr)
-{
-    if ((mPtr != NULL) && (--mPtr->refCount <= 0)) {
-	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
-	    mPtr->typePtr->deleteProc(mPtr->clientData);
-	}
-	if (mPtr->namePtr != NULL) {
-	    Tcl_DecrRefCount(mPtr->namePtr);
-	}
-
-	ckfree(mPtr);
-    }
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOONewBasicMethod --
- *
- *	Helper that makes it cleaner to create very simple methods during
- *	basic system initialization. Not suitable for general use.
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOONewBasicMethod(
-    Tcl_Interp *interp,
-    Class *clsPtr,		/* Class to attach the method to. */
-    const DeclaredClassMethod *dcm)
-				/* Name of the method, whether it is public,
-				 * and the function to implement it. */
-{
-    Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1);
-
-    Tcl_IncrRefCount(namePtr);
-    Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr,
-	    (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL);
-    Tcl_DecrRefCount(namePtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOONewProcInstanceMethod --
- *
- *	Create a new procedure-like method for an object.
- *
- * ----------------------------------------------------------------------
- */
-
-Method *
-TclOONewProcInstanceMethod(
-    Tcl_Interp *interp,		/* The interpreter containing the object. */
-    Object *oPtr,		/* The object to modify. */
-    int flags,			/* Whether this is a public method. */
-    Tcl_Obj *nameObj,		/* The name of the method, which must not be
-				 * NULL. */
-    Tcl_Obj *argsObj,		/* The formal argument list for the method,
-				 * which must not be NULL. */
-    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
-				 * NULL. */
-    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
-				 * structure to allow for deeper tuning of the
-				 * structure's contents. NULL if caller is not
-				 * interested. */
-{
-    int argsLen;
-    register ProcedureMethod *pmPtr;
-    Tcl_Method method;
-
-    if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
-	return NULL;
-    }
-    pmPtr = ckalloc(sizeof(ProcedureMethod));
-    memset(pmPtr, 0, sizeof(ProcedureMethod));
-    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
-    pmPtr->flags = flags & USE_DECLARER_NS;
-    pmPtr->refCount = 1;
-
-    method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
-	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
-    if (method == NULL) {
-	ckfree(pmPtr);
-    } else if (pmPtrPtr != NULL) {
-	*pmPtrPtr = pmPtr;
-    }
-    return (Method *) method;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOONewProcMethod --
- *
- *	Create a new procedure-like method for a class.
- *
- * ----------------------------------------------------------------------
- */
-
-Method *
-TclOONewProcMethod(
-    Tcl_Interp *interp,		/* The interpreter containing the class. */
-    Class *clsPtr,		/* The class to modify. */
-    int flags,			/* Whether this is a public method. */
-    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
-				 * if so, up to caller to manage storage
-				 * (e.g., because it is a constructor or
-				 * destructor). */
-    Tcl_Obj *argsObj,		/* The formal argument list for the method,
-				 * which may be NULL; if so, it is equivalent
-				 * to an empty list. */
-    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
-				 * NULL. */
-    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
-				 * structure to allow for deeper tuning of the
-				 * structure's contents. NULL if caller is not
-				 * interested. */
-{
-    int argsLen;		/* -1 => delete argsObj before exit */
-    register ProcedureMethod *pmPtr;
-    const char *procName;
-    Tcl_Method method;
-
-    if (argsObj == NULL) {
-	argsLen = -1;
-	argsObj = Tcl_NewObj();
-	Tcl_IncrRefCount(argsObj);
-	procName = "<destructor>";
-    } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
-	return NULL;
-    } else {
-	procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
-    }
-
-    pmPtr = ckalloc(sizeof(ProcedureMethod));
-    memset(pmPtr, 0, sizeof(ProcedureMethod));
-    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
-    pmPtr->flags = flags & USE_DECLARER_NS;
-    pmPtr->refCount = 1;
-
-    method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
-	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
-
-    if (argsLen == -1) {
-	Tcl_DecrRefCount(argsObj);
-    }
-    if (method == NULL) {
-	ckfree(pmPtr);
-    } else if (pmPtrPtr != NULL) {
-	*pmPtrPtr = pmPtr;
-    }
-
-    return (Method *) method;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOMakeProcInstanceMethod --
- *
- *	The guts of the code to make a procedure-like method for an object.
- *	Split apart so that it is easier for other extensions to reuse (in
- *	particular, it frees them from having to pry so deeply into Tcl's
- *	guts).
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Method
-TclOOMakeProcInstanceMethod(
-    Tcl_Interp *interp,		/* The interpreter containing the object. */
-    Object *oPtr,		/* The object to modify. */
-    int flags,			/* Whether this is a public method. */
-    Tcl_Obj *nameObj,		/* The name of the method, which _must not_ be
-				 * NULL. */
-    Tcl_Obj *argsObj,		/* The formal argument list for the method,
-				 * which _must not_ be NULL. */
-    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
-				 * NULL. */
-    const Tcl_MethodType *typePtr,
-				/* The type of the method to create. */
-    ClientData clientData,	/* The per-method type-specific data. */
-    Proc **procPtrPtr)		/* A pointer to the variable in which to write
-				 * the procedure record reference. Presumably
-				 * inside the structure indicated by the
-				 * pointer in clientData. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Proc *procPtr;
-
-    if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
-	    procPtrPtr) != TCL_OK) {
-	return NULL;
-    }
-    procPtr = *procPtrPtr;
-    procPtr->cmdPtr = NULL;
-
-    if (iPtr->cmdFramePtr) {
-	CmdFrame context = *iPtr->cmdFramePtr;
-
-	if (context.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.
-	     */
-
-	    TclGetSrcInfoForPc(&context);
-	} else if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * The copy into 'context' up above has created another reference
-	     * to 'context.data.eval.path'; account for it.
-	     */
-
-	    Tcl_IncrRefCount(context.data.eval.path);
-	}
-
-	if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * We can account for source location within a proc only if the
-	     * proc body was not created by substitution.
-	     * (FIXME: check that this is sane and correct!)
-	     */
-
-	    if (context.line
-		    && (context.nline >= 4) && (context.line[3] >= 0)) {
-		int isNew;
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-		Tcl_HashEntry *hPtr;
-
-		cfPtr->level = -1;
-		cfPtr->type = context.type;
-		cfPtr->line = ckalloc(sizeof(int));
-		cfPtr->line[0] = context.line[3];
-		cfPtr->nline = 1;
-		cfPtr->framePtr = NULL;
-		cfPtr->nextPtr = NULL;
-
-		cfPtr->data.eval.path = context.data.eval.path;
-		Tcl_IncrRefCount(cfPtr->data.eval.path);
-
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
-
-		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			(char *) procPtr, &isNew);
-		Tcl_SetHashValue(hPtr, cfPtr);
-	    }
-
-	    /*
-	     * 'context' is going out of scope; account for the reference that
-	     * it's holding to the path name.
-	     */
-
-	    Tcl_DecrRefCount(context.data.eval.path);
-	    context.data.eval.path = NULL;
-	}
-    }
-
-    return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
-	    typePtr, clientData);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOMakeProcMethod --
- *
- *	The guts of the code to make a procedure-like method for a class.
- *	Split apart so that it is easier for other extensions to reuse (in
- *	particular, it frees them from having to pry so deeply into Tcl's
- *	guts).
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Method
-TclOOMakeProcMethod(
-    Tcl_Interp *interp,		/* The interpreter containing the class. */
-    Class *clsPtr,		/* The class to modify. */
-    int flags,			/* Whether this is a public method. */
-    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
-				 * if so, up to caller to manage storage
-				 * (e.g., because it is a constructor or
-				 * destructor). */
-    const char *namePtr,	/* The name of the method as a string, which
-				 * _must not_ be NULL. */
-    Tcl_Obj *argsObj,		/* The formal argument list for the method,
-				 * which _must not_ be NULL. */
-    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
-				 * NULL. */
-    const Tcl_MethodType *typePtr,
-				/* The type of the method to create. */
-    ClientData clientData,	/* The per-method type-specific data. */
-    Proc **procPtrPtr)		/* A pointer to the variable in which to write
-				 * the procedure record reference. Presumably
-				 * inside the structure indicated by the
-				 * pointer in clientData. */
-{
-    Interp *iPtr = (Interp *) interp;
-    Proc *procPtr;
-
-    if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
-	    procPtrPtr) != TCL_OK) {
-	return NULL;
-    }
-    procPtr = *procPtrPtr;
-    procPtr->cmdPtr = NULL;
-
-    if (iPtr->cmdFramePtr) {
-	CmdFrame context = *iPtr->cmdFramePtr;
-
-	if (context.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.
-	     */
-
-	    TclGetSrcInfoForPc(&context);
-	} else if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * The copy into 'context' up above has created another reference
-	     * to 'context.data.eval.path'; account for it.
-	     */
-
-	    Tcl_IncrRefCount(context.data.eval.path);
-	}
-
-	if (context.type == TCL_LOCATION_SOURCE) {
-	    /*
-	     * We can account for source location within a proc only if the
-	     * proc body was not created by substitution.
-	     * (FIXME: check that this is sane and correct!)
-	     */
-
-	    if (context.line
-		    && (context.nline >= 4) && (context.line[3] >= 0)) {
-		int isNew;
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-		Tcl_HashEntry *hPtr;
-
-		cfPtr->level = -1;
-		cfPtr->type = context.type;
-		cfPtr->line = ckalloc(sizeof(int));
-		cfPtr->line[0] = context.line[3];
-		cfPtr->nline = 1;
-		cfPtr->framePtr = NULL;
-		cfPtr->nextPtr = NULL;
-
-		cfPtr->data.eval.path = context.data.eval.path;
-		Tcl_IncrRefCount(cfPtr->data.eval.path);
-
-		cfPtr->cmd.str.cmd = NULL;
-		cfPtr->cmd.str.len = 0;
-
-		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			(char *) procPtr, &isNew);
-		Tcl_SetHashValue(hPtr, cfPtr);
-	    }
-
-	    /*
-	     * 'context' is going out of scope; account for the reference that
-	     * it's holding to the path name.
-	     */
-
-	    Tcl_DecrRefCount(context.data.eval.path);
-	    context.data.eval.path = NULL;
-	}
-    }
-
-    return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
-	    clientData);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InvokeProcedureMethod, PushMethodCallFrame --
- *
- *	How to invoke a procedure-like method.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InvokeProcedureMethod(
-    ClientData clientData,	/* Pointer to some per-method context. */
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,	/* The method calling context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
-{
-    ProcedureMethod *pmPtr = clientData;
-    int result;
-    PMFrameData *fdPtr;		/* Important data that has to have a lifetime
-				 * matched by this function (or rather, by the
-				 * call frame's lifetime). */
-
-    /*
-     * If the interpreter was deleted, we just skip to the next thing in the
-     * chain.
-     */
-
-    if (Tcl_InterpDeleted(interp)) {
-	return TclNRObjectContextInvokeNext(interp, context, objc, objv,
-		Tcl_ObjectContextSkippedArgs(context));
-    }
-
-    /*
-     * Allocate the special frame data.
-     */
-
-    fdPtr = TclStackAlloc(interp, sizeof(PMFrameData));
-
-    /*
-     * Create a call frame for this method.
-     */
-
-    result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr,
-	    objc, objv, fdPtr);
-    if (result != TCL_OK) {
-	TclStackFree(interp, fdPtr);
-	return result;
-    }
-    pmPtr->refCount++;
-
-    /*
-     * Give the pre-call callback a chance to do some setup and, possibly,
-     * veto the call.
-     */
-
-    if (pmPtr->preCallProc != NULL) {
-	int isFinished;
-
-	result = pmPtr->preCallProc(pmPtr->clientData, interp, context,
-		(Tcl_CallFrame *) fdPtr->framePtr, &isFinished);
-	if (isFinished || result != TCL_OK) {
-	    /*
-	     * Restore the old cmdPtr so that a subsequent use of [info frame]
-	     * won't crash on us. [Bug 3001438]
-	     */
-
-	    pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
-
-	    Tcl_PopCallFrame(interp);
-	    TclStackFree(interp, fdPtr->framePtr);
-	    if (--pmPtr->refCount < 1) {
-		DeleteProcedureMethodRecord(pmPtr);
-	    }
-	    TclStackFree(interp, fdPtr);
-	    return result;
-	}
-    }
-
-    /*
-     * Now invoke the body of the method.
-     */
-
-    TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
-    return TclNRInterpProcCore(interp, fdPtr->nameObj,
-	    Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
-}
-
-static int
-FinalizePMCall(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    ProcedureMethod *pmPtr = data[0];
-    Tcl_ObjectContext context = data[1];
-    PMFrameData *fdPtr = data[2];
-
-    /*
-     * Give the post-call callback a chance to do some cleanup. Note that at
-     * this point the call frame itself is invalid; it's already been popped.
-     */
-
-    if (pmPtr->postCallProc) {
-	result = pmPtr->postCallProc(pmPtr->clientData, interp, context,
-		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),
-		result);
-    }
-
-    /*
-     * Restore the old cmdPtr so that a subsequent use of [info frame] won't
-     * crash on us. [Bug 3001438]
-     */
-
-    pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
-
-    /*
-     * Scrap the special frame data now that we're done with it. Note that we
-     * are inlining DeleteProcedureMethod() here; this location is highly
-     * sensitive when it comes to performance!
-     */
-
-    if (--pmPtr->refCount < 1) {
-	DeleteProcedureMethodRecord(pmPtr);
-    }
-    TclStackFree(interp, fdPtr);
-    return result;
-}
-
-static int
-PushMethodCallFrame(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    CallContext *contextPtr,	/* Current method call context. */
-    ProcedureMethod *pmPtr,	/* Information about this procedure-like
-				 * method. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv,	/* Array of arguments. */
-    PMFrameData *fdPtr)		/* Place to store information about the call
-				 * frame. */
-{
-    Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr;
-    register int result;
-    const char *namePtr;
-    CallFrame **framePtrPtr = &fdPtr->framePtr;
-
-    /*
-     * Compute basic information on the basis of the type of method it is.
-     */
-
-    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
-	namePtr = "<constructor>";
-	fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName;
-	fdPtr->errProc = ConstructorErrorHandler;
-    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
-	namePtr = "<destructor>";
-	fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName;
-	fdPtr->errProc = DestructorErrorHandler;
-    } else {
-	fdPtr->nameObj = Tcl_MethodName(
-		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr));
-	namePtr = TclGetString(fdPtr->nameObj);
-	fdPtr->errProc = MethodErrorHandler;
-    }
-    if (pmPtr->errProc != NULL) {
-	fdPtr->errProc = pmPtr->errProc;
-    }
-
-    /*
-     * Magic to enable things like [incr Tcl], which wants methods to run in
-     * their class's namespace.
-     */
-
-    if (pmPtr->flags & USE_DECLARER_NS) {
-	register Method *mPtr =
-		contextPtr->callPtr->chain[contextPtr->index].mPtr;
-
-	if (mPtr->declaringClassPtr != NULL) {
-	    nsPtr = (Namespace *)
-		    mPtr->declaringClassPtr->thisPtr->namespacePtr;
-	} else {
-	    nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr;
-	}
-    }
-
-    /*
-     * Save the old cmdPtr so that when this recursive call returns, we can
-     * restore it. To do otherwise causes crashes in [info frame] after we
-     * return from a recursive call. [Bug 3001438]
-     */
-
-    fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr;
-
-    /*
-     * Compile the body. This operation may fail.
-     */
-
-    fdPtr->efi.length = 2;
-    memset(&fdPtr->cmd, 0, sizeof(Command));
-    fdPtr->cmd.nsPtr = nsPtr;
-    fdPtr->cmd.clientData = &fdPtr->efi;
-    pmPtr->procPtr->cmdPtr = &fdPtr->cmd;
-
-    /*
-     * [Bug 2037727] Always call TclProcCompileProc so that we check not only
-     * that we have bytecode, but also that it remains valid. Note that we set
-     * the namespace of the code here directly; this is a hack, but the
-     * alternative is *so* slow...
-     */
-
-    if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
-	ByteCode *codePtr =
-		pmPtr->procPtr->bodyPtr->internalRep.otherValuePtr;
-
-	codePtr->nsPtr = nsPtr;
-    }
-    result = TclProcCompileProc(interp, pmPtr->procPtr,
-	    pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr);
-    if (result != TCL_OK) {
-	goto failureReturn;
-    }
-
-    /*
-     * Make the stack frame and fill it out with information about this call.
-     * This operation may fail.
-     */
-
-    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
-	    (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);
-    if (result != TCL_OK) {
-	goto failureReturn;
-    }
-
-    fdPtr->framePtr->clientData = contextPtr;
-    fdPtr->framePtr->objc = objc;
-    fdPtr->framePtr->objv = objv;
-    fdPtr->framePtr->procPtr = pmPtr->procPtr;
-
-    /*
-     * Finish filling out the extra frame info so that [info frame] works.
-     */
-
-    fdPtr->efi.fields[0].name = "method";
-    fdPtr->efi.fields[0].proc = NULL;
-    fdPtr->efi.fields[0].clientData = fdPtr->nameObj;
-    if (pmPtr->gfivProc != NULL) {
-	fdPtr->efi.fields[1].name = "";
-	fdPtr->efi.fields[1].proc = pmPtr->gfivProc;
-	fdPtr->efi.fields[1].clientData = pmPtr;
-    } else {
-	register Tcl_Method method =
-		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr);
-
-	if (Tcl_MethodDeclarerObject(method) != NULL) {
-	    fdPtr->efi.fields[1].name = "object";
-	} else {
-	    fdPtr->efi.fields[1].name = "class";
-	}
-	fdPtr->efi.fields[1].proc = RenderDeclarerName;
-	fdPtr->efi.fields[1].clientData = &fdPtr->pni;
-	fdPtr->pni.interp = interp;
-	fdPtr->pni.method = method;
-    }
-
-    return TCL_OK;
-
-    /*
-     * Restore the old cmdPtr so that a subsequent use of [info frame] won't
-     * crash on us. [Bug 3001438]
-     */
-
-  failureReturn:
-    pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOSetupVariableResolver, etc. --
- *
- *	Variable resolution engine used to connect declared variables to local
- *	variables used in methods. The compiled variable resolver is more
- *	important, but both are needed as it is possible to have a variable
- *	that is only referred to in ways that aren't compilable and we can't
- *	force LVT presence. [TIP #320]
- *
- * ----------------------------------------------------------------------
- */
-
-void
-TclOOSetupVariableResolver(
-    Tcl_Namespace *nsPtr)
-{
-    Tcl_ResolverInfo info;
-
-    Tcl_GetNamespaceResolvers(nsPtr, &info);
-    if (info.compiledVarResProc == NULL) {
-	Tcl_SetNamespaceResolvers(nsPtr, NULL, ProcedureMethodVarResolver,
-		ProcedureMethodCompiledVarResolver);
-    }
-}
-
-static int
-ProcedureMethodVarResolver(
-    Tcl_Interp *interp,
-    const char *varName,
-    Tcl_Namespace *contextNs,
-    int flags,
-    Tcl_Var *varPtr)
-{
-    int result;
-    Tcl_ResolvedVarInfo *rPtr = NULL;
-    
-    result = ProcedureMethodCompiledVarResolver(interp, varName,
-	    strlen(varName), contextNs, &rPtr);
-
-    if (result != TCL_OK) {
-	return result;
-    }
-
-    *varPtr = rPtr->fetchProc(interp, rPtr);
-
-    /*
-     * Must not retain reference to resolved information. [Bug 3105999]
-     */
-
-    if (rPtr != NULL) {
-	rPtr->deleteProc(rPtr);
-    }
-    return (*varPtr? TCL_OK : TCL_CONTINUE);
-}
-
-static Tcl_Var
-ProcedureMethodCompiledVarConnect(
-    Tcl_Interp *interp,
-    Tcl_ResolvedVarInfo *rPtr)
-{
-    OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *framePtr = iPtr->varFramePtr;
-    CallContext *contextPtr;
-    Tcl_Obj *variableObj;
-    Tcl_HashEntry *hPtr;
-    int i, isNew, cacheIt, varLen, len;
-    const char *match, *varName;
-
-    /*
-     * Check that the variable is being requested in a context that is also a
-     * method call; if not (i.e. we're evaluating in the object's namespace or
-     * in a procedure of that namespace) then we do nothing.
-     */
-
-    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
-	return NULL;
-    }
-    contextPtr = framePtr->clientData;
-
-    /*
-     * If we've done the work before (in a comparable context) then reuse that
-     * rather than performing resolution ourselves.
-     */
-
-    if (infoPtr->cachedObjectVar) {
-	return infoPtr->cachedObjectVar;
-    }
-
-    /*
-     * Check if the variable is one we want to resolve at all (i.e. whether it
-     * is in the list provided by the user). If not, we mustn't do anything
-     * either.
-     */
-
-    varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
-    if (contextPtr->callPtr->chain[contextPtr->index]
-	    .mPtr->declaringClassPtr != NULL) {
-	FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
-		.mPtr->declaringClassPtr->variables) {
-	    match = TclGetStringFromObj(variableObj, &len);
-	    if ((len == varLen) && !memcmp(match, varName, len)) {
-		cacheIt = 0;
-		goto gotMatch;
-	    }
-	}
-    } else {
-	FOREACH(variableObj, contextPtr->oPtr->variables) {
-	    match = TclGetStringFromObj(variableObj, &len);
-	    if ((len == varLen) && !memcmp(match, varName, len)) {
-		cacheIt = 1;
-		goto gotMatch;
-	    }
-	}
-    }
-    return NULL;
-
-    /*
-     * It is a variable we want to resolve, so resolve it.
-     */
-
-  gotMatch:
-    hPtr = Tcl_CreateHashEntry(TclVarTable(contextPtr->oPtr->namespacePtr),
-	    (char *) variableObj, &isNew);
-    if (isNew) {
-	TclSetVarNamespaceVar((Var *) TclVarHashGetValue(hPtr));
-    }
-    if (cacheIt) {
-	infoPtr->cachedObjectVar = TclVarHashGetValue(hPtr);
-
-	/*
-	 * We must keep a reference to the variable so everything will
-	 * continue to work correctly even if it is unset; being unset does
-	 * not end the life of the variable at this level. [Bug 3185009]
-	 */
-
-	VarHashRefCount(infoPtr->cachedObjectVar)++;
-    }
-    return TclVarHashGetValue(hPtr);
-}
-
-static void
-ProcedureMethodCompiledVarDelete(
-    Tcl_ResolvedVarInfo *rPtr)
-{
-    OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
-
-    /*
-     * Release the reference to the variable if we were holding it.
-     */
-
-    if (infoPtr->cachedObjectVar) {
-	VarHashRefCount(infoPtr->cachedObjectVar)--;
-	TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL);
-    }
-    Tcl_DecrRefCount(infoPtr->variableObj);
-    ckfree(infoPtr);
-}
-
-static int
-ProcedureMethodCompiledVarResolver(
-    Tcl_Interp *interp,
-    const char *varName,
-    int length,
-    Tcl_Namespace *contextNs,
-    Tcl_ResolvedVarInfo **rPtrPtr)
-{
-    OOResVarInfo *infoPtr;
-    Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length);
-
-    /*
-     * Do not create resolvers for cases that contain namespace separators or
-     * which look like array accesses. Both will lead us astray.
-     */
-
-    if (strstr(Tcl_GetString(variableObj), "::") != NULL ||
-	    Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) {
-	Tcl_DecrRefCount(variableObj);
-	return TCL_CONTINUE;
-    }
-
-    infoPtr = ckalloc(sizeof(OOResVarInfo));
-    infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
-    infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
-    infoPtr->cachedObjectVar = NULL;
-    infoPtr->variableObj = variableObj;
-    Tcl_IncrRefCount(variableObj);
-    *rPtrPtr = &infoPtr->info;
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * RenderDeclarerName --
- *
- *	Returns the name of the entity (object or class) which declared a
- *	method. Used for producing information for [info frame] in such a way
- *	that the expensive part of this (generating the object or class name
- *	itself) isn't done until it is needed.
- *
- * ----------------------------------------------------------------------
- */
-
-static Tcl_Obj *
-RenderDeclarerName(
-    ClientData clientData)
-{
-    struct PNI *pni = clientData;
-    Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);
-
-    if (object == NULL) {
-	object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
-    }
-    return TclOOObjectName(pni->interp, (Object *) object);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler --
- *
- *	How to fill in the stack trace correctly upon error in various forms
- *	of procedure-like methods. LIMIT is how long the inserted strings in
- *	the error traces should get before being converted to have ellipses,
- *	and ELLIPSIFY is a macro to do the conversion (with the help of a
- *	%.*s%s format field). Note that ELLIPSIFY is only safe for use in
- *	suitable formatting contexts.
- *
- * ----------------------------------------------------------------------
- */
-
-#define LIMIT 60
-#define ELLIPSIFY(str,len) \
-	((len) > LIMIT ? LIMIT : (len)), (str), ((len) > LIMIT ? "..." : "")
-
-static void
-MethodErrorHandler(
-    Tcl_Interp *interp,
-    Tcl_Obj *methodNameObj)
-{
-    int nameLen, objectNameLen;
-    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
-    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
-    const char *objectName, *kindName, *methodName =
-	    Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
-    Object *declarerPtr;
-
-    if (mPtr->declaringObjectPtr != NULL) {
-	declarerPtr = mPtr->declaringObjectPtr;
-	kindName = "object";
-    } else {
-	if (mPtr->declaringClassPtr == NULL) {
-	    Tcl_Panic("method not declared in class or object");
-	}
-	declarerPtr = mPtr->declaringClassPtr->thisPtr;
-	kindName = "class";
-    }
-
-    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
-	    &objectNameLen);
-    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-	    "\n    (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
-	    kindName, ELLIPSIFY(objectName, objectNameLen),
-	    ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp)));
-}
-
-static void
-ConstructorErrorHandler(
-    Tcl_Interp *interp,
-    Tcl_Obj *methodNameObj)
-{
-    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
-    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
-    Object *declarerPtr;
-    const char *objectName, *kindName;
-    int objectNameLen;
-
-    if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) {
-	/*
-	 * Horrible hack to deal with certain constructors that must not add
-	 * information to the error trace.
-	 */
-
-	return;
-    }
-
-    if (mPtr->declaringObjectPtr != NULL) {
-	declarerPtr = mPtr->declaringObjectPtr;
-	kindName = "object";
-    } else {
-	if (mPtr->declaringClassPtr == NULL) {
-	    Tcl_Panic("method not declared in class or object");
-	}
-	declarerPtr = mPtr->declaringClassPtr->thisPtr;
-	kindName = "class";
-    }
-
-    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
-	    &objectNameLen);
-    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-	    "\n    (%s \"%.*s%s\" constructor line %d)", kindName,
-	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
-}
-
-static void
-DestructorErrorHandler(
-    Tcl_Interp *interp,
-    Tcl_Obj *methodNameObj)
-{
-    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
-    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
-    Object *declarerPtr;
-    const char *objectName, *kindName;
-    int objectNameLen;
-
-    if (mPtr->declaringObjectPtr != NULL) {
-	declarerPtr = mPtr->declaringObjectPtr;
-	kindName = "object";
-    } else {
-	if (mPtr->declaringClassPtr == NULL) {
-	    Tcl_Panic("method not declared in class or object");
-	}
-	declarerPtr = mPtr->declaringClassPtr->thisPtr;
-	kindName = "class";
-    }
-
-    objectName = Tcl_GetStringFromObj(TclOOObjectName(interp, declarerPtr),
-	    &objectNameLen);
-    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-	    "\n    (%s \"%.*s%s\" destructor line %d)", kindName,
-	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * DeleteProcedureMethod, CloneProcedureMethod --
- *
- *	How to delete and clone procedure-like methods.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-DeleteProcedureMethodRecord(
-    ProcedureMethod *pmPtr)
-{
-    TclProcDeleteProc(pmPtr->procPtr);
-    if (pmPtr->deleteClientdataProc) {
-	pmPtr->deleteClientdataProc(pmPtr->clientData);
-    }
-    ckfree(pmPtr);
-}
-
-static void
-DeleteProcedureMethod(
-    ClientData clientData)
-{
-    register ProcedureMethod *pmPtr = clientData;
-
-    if (--pmPtr->refCount < 1) {
-	DeleteProcedureMethodRecord(pmPtr);
-    }
-}
-
-static int
-CloneProcedureMethod(
-    Tcl_Interp *interp,
-    ClientData clientData,
-    ClientData *newClientData)
-{
-    ProcedureMethod *pmPtr = clientData;
-    ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod));
-
-    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
-    pm2Ptr->refCount = 1;
-    pm2Ptr->procPtr->refCount++;
-    if (pmPtr->cloneClientdataProc) {
-	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
-    }
-    *newClientData = pm2Ptr;
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOONewForwardMethod --
- *
- *	Create a forwarded method for an object.
- *
- * ----------------------------------------------------------------------
- */
-
-Method *
-TclOONewForwardInstanceMethod(
-    Tcl_Interp *interp,		/* Interpreter for error reporting. */
-    Object *oPtr,		/* The object to attach the method to. */
-    int flags,			/* Whether the method is public or not. */
-    Tcl_Obj *nameObj,		/* The name of the method. */
-    Tcl_Obj *prefixObj)		/* List of arguments that form the command
-				 * prefix to forward to. */
-{
-    int prefixLen;
-    register ForwardMethod *fmPtr;
-    Tcl_Obj *cmdObj;
-
-    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
-	return NULL;
-    }
-    if (prefixLen < 1) {
-	Tcl_AppendResult(interp, "method forward prefix must be non-empty",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
-	return NULL;
-    }
-
-    fmPtr = ckalloc(sizeof(ForwardMethod));
-    fmPtr->prefixObj = prefixObj;
-    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
-    fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
-    Tcl_IncrRefCount(prefixObj);
-    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
-	    nameObj, flags, &fwdMethodType, fmPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOONewForwardMethod --
- *
- *	Create a new forwarded method for a class.
- *
- * ----------------------------------------------------------------------
- */
-
-Method *
-TclOONewForwardMethod(
-    Tcl_Interp *interp,		/* Interpreter for error reporting. */
-    Class *clsPtr,		/* The class to attach the method to. */
-    int flags,			/* Whether the method is public or not. */
-    Tcl_Obj *nameObj,		/* The name of the method. */
-    Tcl_Obj *prefixObj)		/* List of arguments that form the command
-				 * prefix to forward to. */
-{
-    int prefixLen;
-    register ForwardMethod *fmPtr;
-    Tcl_Obj *cmdObj;
-
-    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
-	return NULL;
-    }
-    if (prefixLen < 1) {
-	Tcl_AppendResult(interp, "method forward prefix must be non-empty",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
-	return NULL;
-    }
-
-    fmPtr = ckalloc(sizeof(ForwardMethod));
-    fmPtr->prefixObj = prefixObj;
-    Tcl_ListObjIndex(interp, prefixObj, 0, &cmdObj);
-    fmPtr->fullyQualified = (strncmp(TclGetString(cmdObj), "::", 2) == 0);
-    Tcl_IncrRefCount(prefixObj);
-    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
-	    flags, &fwdMethodType, fmPtr);
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InvokeForwardMethod --
- *
- *	How to invoke a forwarded method. Works by doing some ensemble-like
- *	command rearranging and then invokes some other Tcl command.
- *
- * ----------------------------------------------------------------------
- */
-
-static int
-InvokeForwardMethod(
-    ClientData clientData,	/* Pointer to some per-method context. */
-    Tcl_Interp *interp,
-    Tcl_ObjectContext context,	/* The method calling context. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
-{
-    CallContext *contextPtr = (CallContext *) context;
-    ForwardMethod *fmPtr = clientData;
-    Tcl_Obj **argObjs, **prefixObjs;
-    int numPrefixes, len, skip = contextPtr->skip;
-    Command *cmdPtr;
-
-    /*
-     * Build the real list of arguments to use. Note that we know that the
-     * prefixObj field of the ForwardMethod structure holds a reference to a
-     * non-empty list, so there's a whole class of failures ("not a list") we
-     * can ignore here.
-     */
-
-    Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
-    argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
-	    numPrefixes, prefixObjs, &len);
-
-    if (fmPtr->fullyQualified) {
-	cmdPtr = NULL;
-    } else {
-	cmdPtr = (Command *) Tcl_FindCommand(interp, TclGetString(argObjs[0]),
-		contextPtr->oPtr->namespacePtr, 0 /* normal lookup */);
-    }
-    Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
-    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE, cmdPtr);
-}
-
-static int
-FinalizeForwardCall(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Tcl_Obj **argObjs = data[0];
-    
-    TclStackFree(interp, argObjs);
-    return result;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * DeleteForwardMethod, CloneForwardMethod --
- *
- *	How to delete and clone forwarded methods.
- *
- * ----------------------------------------------------------------------
- */
-
-static void
-DeleteForwardMethod(
-    ClientData clientData)
-{
-    ForwardMethod *fmPtr = clientData;
-
-    Tcl_DecrRefCount(fmPtr->prefixObj);
-    ckfree(fmPtr);
-}
-
-static int
-CloneForwardMethod(
-    Tcl_Interp *interp,
-    ClientData clientData,
-    ClientData *newClientData)
-{
-    ForwardMethod *fmPtr = clientData;
-    ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));
-
-    fm2Ptr->prefixObj = fmPtr->prefixObj;
-    fm2Ptr->fullyQualified = fmPtr->fullyQualified;
-    Tcl_IncrRefCount(fm2Ptr->prefixObj);
-    *newClientData = fm2Ptr;
-    return TCL_OK;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * TclOOGetProcFromMethod, TclOOGetFwdFromMethod --
- *
- *	Utility functions used for procedure-like and forwarding method
- *	introspection.
- *
- * ----------------------------------------------------------------------
- */
-
-Proc *
-TclOOGetProcFromMethod(
-    Method *mPtr)
-{
-    if (mPtr->typePtr == &procMethodType) {
-	ProcedureMethod *pmPtr = mPtr->clientData;
-
-	return pmPtr->procPtr;
-    }
-    return NULL;
-}
-
-Tcl_Obj *
-TclOOGetMethodBody(
-    Method *mPtr)
-{
-    if (mPtr->typePtr == &procMethodType) {
-	ProcedureMethod *pmPtr = mPtr->clientData;
-
-	if (pmPtr->procPtr->bodyPtr->bytes == NULL) {
-	    (void) Tcl_GetString(pmPtr->procPtr->bodyPtr);
-	}
-	return pmPtr->procPtr->bodyPtr;
-    }
-    return NULL;
-}
-
-Tcl_Obj *
-TclOOGetFwdFromMethod(
-    Method *mPtr)
-{
-    if (mPtr->typePtr == &fwdMethodType) {
-	ForwardMethod *fwPtr = mPtr->clientData;
-
-	return fwPtr->prefixObj;
-    }
-    return NULL;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * InitEnsembleRewrite --
- *
- *	Utility function that wraps up a lot of the complexity involved in
- *	doing ensemble-like command forwarding. Here is a picture of memory
- *	management plan:
- *
- *                    <-----------------objc---------------------->
- *      objv:        |=============|===============================|
- *                    <-toRewrite->           |
- *                                             \
- *                    <-rewriteLength->         \
- *      rewriteObjs: |=================|         \
- *                           |                    |
- *                           V                    V
- *      argObjs:     |=================|===============================|
- *                    <------------------*lengthPtr------------------->
- *
- * ----------------------------------------------------------------------
- */
-
-static Tcl_Obj **
-InitEnsembleRewrite(
-    Tcl_Interp *interp,		/* Place to log the rewrite info. */
-    int objc,			/* Number of real arguments. */
-    Tcl_Obj *const *objv,	/* The real arguments. */
-    int toRewrite,		/* Number of real arguments to replace. */
-    int rewriteLength,		/* Number of arguments to insert instead. */
-    Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
-    int *lengthPtr)		/* Where to write the resulting length of the
-				 * array of rewritten arguments. */
-{
-    Interp *iPtr = (Interp *) interp;
-    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-    Tcl_Obj **argObjs;
-    unsigned len = rewriteLength + objc - toRewrite;
-
-    argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
-    memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
-    memcpy(argObjs + rewriteLength, objv + toRewrite,
-	    sizeof(Tcl_Obj *) * (objc - toRewrite));
-
-    /*
-     * Now plumb this into the core ensemble rewrite logging system so that
-     * Tcl_WrongNumArgs() can rewrite its result appropriately. The rules for
-     * how to store the rewrite rules get complex solely because of the case
-     * where an ensemble rewrites itself out of the picture; when that
-     * happens, the quality of the error message rewrite falls drastically
-     * (and unavoidably).
-     */
-
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = objv;
-	iPtr->ensembleRewrite.numRemovedObjs = toRewrite;
-	iPtr->ensembleRewrite.numInsertedObjs = rewriteLength;
-    } else {
-	int numIns = iPtr->ensembleRewrite.numInsertedObjs;
-
-	if (numIns < toRewrite) {
-	    iPtr->ensembleRewrite.numRemovedObjs += toRewrite - numIns;
-	    iPtr->ensembleRewrite.numInsertedObjs += rewriteLength - 1;
-	} else {
-	    iPtr->ensembleRewrite.numInsertedObjs +=
-		    rewriteLength - toRewrite;
-	}
-    }
-
-    *lengthPtr = len;
-    return argObjs;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
- * assorted trivial 'getter' functions
- *
- * ----------------------------------------------------------------------
- */
-
-Tcl_Object
-Tcl_MethodDeclarerObject(
-    Tcl_Method method)
-{
-    return (Tcl_Object) ((Method *) method)->declaringObjectPtr;
-}
-
-Tcl_Class
-Tcl_MethodDeclarerClass(
-    Tcl_Method method)
-{
-    return (Tcl_Class) ((Method *) method)->declaringClassPtr;
-}
-
-Tcl_Obj *
-Tcl_MethodName(
-    Tcl_Method method)
-{
-    return ((Method *) method)->namePtr;
-}
-
-int
-Tcl_MethodIsType(
-    Tcl_Method method,
-    const Tcl_MethodType *typePtr,
-    ClientData *clientDataPtr)
-{
-    Method *mPtr = (Method *) method;
-
-    if (mPtr->typePtr == typePtr) {
-	if (clientDataPtr != NULL) {
-	    *clientDataPtr = mPtr->clientData;
-	}
-	return 1;
-    }
-    return 0;
-}
-
-int
-Tcl_MethodIsPublic(
-    Tcl_Method method)
-{
-    return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
-}
-
-/*
- * Extended method construction for itcl-ng.
- */
-
-Tcl_Method
-TclOONewProcInstanceMethodEx(
-    Tcl_Interp *interp,		/* The interpreter containing the object. */
-    Tcl_Object oPtr,		/* The object to modify. */
-    TclOO_PreCallProc *preCallPtr,
-    TclOO_PostCallProc *postCallPtr,
-    ProcErrorProc *errProc,
-    ClientData clientData,
-    Tcl_Obj *nameObj,		/* The name of the method, which must not be
-				 * NULL. */
-    Tcl_Obj *argsObj,		/* The formal argument list for the method,
-				 * which must not be NULL. */
-    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
-				 * NULL. */
-    int flags,			/* Whether this is a public method. */
-    void **internalTokenPtr)	/* If non-NULL, points to a variable that gets
-				 * the reference to the ProcedureMethod
-				 * structure. */
-{
-    ProcedureMethod *pmPtr;
-    Tcl_Method method = (Tcl_Method) TclOONewProcInstanceMethod(interp,
-	    (Object *) oPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);
-
-    if (method == NULL) {
-	return NULL;
-    }
-    pmPtr->flags = flags & USE_DECLARER_NS;
-    pmPtr->preCallProc = preCallPtr;
-    pmPtr->postCallProc = postCallPtr;
-    pmPtr->errProc = errProc;
-    pmPtr->clientData = clientData;
-    if (internalTokenPtr != NULL) {
-	*internalTokenPtr = pmPtr;
-    }
-    return method;
-}
-
-Tcl_Method
-TclOONewProcMethodEx(
-    Tcl_Interp *interp,		/* The interpreter containing the class. */
-    Tcl_Class clsPtr,		/* The class to modify. */
-    TclOO_PreCallProc *preCallPtr,
-    TclOO_PostCallProc *postCallPtr,
-    ProcErrorProc *errProc,
-    ClientData clientData,
-    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
-				 * if so, up to caller to manage storage
-				 * (e.g., because it is a constructor or
-				 * destructor). */
-    Tcl_Obj *argsObj,		/* The formal argument list for the method,
-				 * which may be NULL; if so, it is equivalent
-				 * to an empty list. */
-    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
-				 * NULL. */
-    int flags,			/* Whether this is a public method. */
-    void **internalTokenPtr)	/* If non-NULL, points to a variable that gets
-				 * the reference to the ProcedureMethod
-				 * structure. */
-{
-    ProcedureMethod *pmPtr;
-    Tcl_Method method = (Tcl_Method) TclOONewProcMethod(interp,
-	    (Class *) clsPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);
-
-    if (method == NULL) {
-	return NULL;
-    }
-    pmPtr->flags = flags & USE_DECLARER_NS;
-    pmPtr->preCallProc = preCallPtr;
-    pmPtr->postCallProc = postCallPtr;
-    pmPtr->errProc = errProc;
-    pmPtr->clientData = clientData;
-    if (internalTokenPtr != NULL) {
-	*internalTokenPtr = pmPtr;
-    }
-    return method;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
deleted file mode 100644
index 900ab22..0000000
--- a/generic/tclOOStubInit.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/*
- * This file is (mostly) automatically generated from tclOO.decls.
- * It is compiled and linked in with the tclOO package proper.
- */
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-#include "tclOOInt.h"
-
-MODULE_SCOPE const TclOOStubs tclOOStubs;
-
-#ifdef __GNUC__
-#pragma GCC dependency "tclOO.decls"
-#endif
-
-/* !BEGIN!: Do not edit below this line. */
-
-static const TclOOIntStubs tclOOIntStubs = {
-    TCL_STUB_MAGIC,
-    0,
-    TclOOGetDefineCmdContext, /* 0 */
-    TclOOMakeProcInstanceMethod, /* 1 */
-    TclOOMakeProcMethod, /* 2 */
-    TclOONewProcInstanceMethod, /* 3 */
-    TclOONewProcMethod, /* 4 */
-    TclOOObjectCmdCore, /* 5 */
-    TclOOIsReachable, /* 6 */
-    TclOONewForwardMethod, /* 7 */
-    TclOONewForwardInstanceMethod, /* 8 */
-    TclOONewProcInstanceMethodEx, /* 9 */
-    TclOONewProcMethodEx, /* 10 */
-    TclOOInvokeObject, /* 11 */
-    TclOOObjectSetFilters, /* 12 */
-    TclOOClassSetFilters, /* 13 */
-    TclOOObjectSetMixins, /* 14 */
-    TclOOClassSetMixins, /* 15 */
-};
-
-static const TclOOStubHooks tclOOStubHooks = {
-    &tclOOIntStubs
-};
-
-const TclOOStubs tclOOStubs = {
-    TCL_STUB_MAGIC,
-    &tclOOStubHooks,
-    Tcl_CopyObjectInstance, /* 0 */
-    Tcl_GetClassAsObject, /* 1 */
-    Tcl_GetObjectAsClass, /* 2 */
-    Tcl_GetObjectCommand, /* 3 */
-    Tcl_GetObjectFromObj, /* 4 */
-    Tcl_GetObjectNamespace, /* 5 */
-    Tcl_MethodDeclarerClass, /* 6 */
-    Tcl_MethodDeclarerObject, /* 7 */
-    Tcl_MethodIsPublic, /* 8 */
-    Tcl_MethodIsType, /* 9 */
-    Tcl_MethodName, /* 10 */
-    Tcl_NewInstanceMethod, /* 11 */
-    Tcl_NewMethod, /* 12 */
-    Tcl_NewObjectInstance, /* 13 */
-    Tcl_ObjectDeleted, /* 14 */
-    Tcl_ObjectContextIsFiltering, /* 15 */
-    Tcl_ObjectContextMethod, /* 16 */
-    Tcl_ObjectContextObject, /* 17 */
-    Tcl_ObjectContextSkippedArgs, /* 18 */
-    Tcl_ClassGetMetadata, /* 19 */
-    Tcl_ClassSetMetadata, /* 20 */
-    Tcl_ObjectGetMetadata, /* 21 */
-    Tcl_ObjectSetMetadata, /* 22 */
-    Tcl_ObjectContextInvokeNext, /* 23 */
-    Tcl_ObjectGetMethodNameMapper, /* 24 */
-    Tcl_ObjectSetMethodNameMapper, /* 25 */
-    Tcl_ClassSetConstructor, /* 26 */
-    Tcl_ClassSetDestructor, /* 27 */
-    Tcl_GetObjectName, /* 28 */
-};
-
-/* !END!: Do not edit above this line. */
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c
deleted file mode 100644
index 3b6ce37..0000000
--- a/generic/tclOOStubLib.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/*
- * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
- */
-
-/*
- * We need to ensure that we use the tcl stub macros so that this file
- * contains no references to any of the tcl stub functions.
- */
-
-#undef USE_TCL_STUBS
-#define USE_TCL_STUBS
-
-#ifdef HAVE_CONFIG_H
-#include "config.h"
-#endif
-
-#define USE_TCLOO_STUBS 1
-#include "tclOOInt.h"
-
-MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
-MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr;
-
-const TclOOStubs *tclOOStubsPtr = NULL;
-const TclOOIntStubs *tclOOIntStubsPtr = NULL;
-
-/*
- *----------------------------------------------------------------------
- *
- * TclOOInitializeStubs --
- *	Load the tclOO package, initialize stub table pointer. Do not call
- *	this function directly, use Tcl_OOInitStubs() macro instead.
- *
- * Results:
- *	The actual version of the package that satisfies the request, or NULL
- *	to indicate that an error occurred.
- *
- * Side effects:
- *	Sets the stub table pointer.
- *
- *----------------------------------------------------------------------
- */
-
-MODULE_SCOPE const char *
-TclOOInitializeStubs(
-    Tcl_Interp *interp, const char *version)
-{
-    int exact = 0;
-    const char *packageName = "TclOO";
-    const char *errMsg = NULL;
-    ClientData clientData = NULL;
-    const char *actualVersion =
-	    Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData);
-
-    if (clientData == NULL) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "Error loading ", packageName, " package; ",
-		"package not present or incomplete", NULL);
-	return NULL;
-    } else {
-	const TclOOStubs * const stubsPtr = clientData;
-	const TclOOIntStubs * const intStubsPtr = stubsPtr->hooks ?
-		stubsPtr->hooks->tclOOIntStubs : NULL;
-
-	if (!actualVersion) {
-	    return NULL;
-	}
-
-	if (!stubsPtr || !intStubsPtr) {
-	    errMsg = "missing stub table pointer";
-	    goto error;
-	}
-
-	tclOOStubsPtr = stubsPtr;
-	tclOOIntStubsPtr = intStubsPtr;
-	return actualVersion;
-
-    error:
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "Error loading ", packageName, " package",
-		" (requested version '", version, "', loaded version '",
-		actualVersion, "'): ", errMsg, NULL);
-	return NULL;
-    }
-}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 099b67d..7b9bb61 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1,29 +1,28 @@
-/*
+/* 
  * tclObj.c --
  *
- *	This file contains Tcl object-related functions that are used by many
- *	Tcl commands.
+ *	This file contains Tcl object-related procedures 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 "tommath.h"
-#include <math.h>
+#include "tclCompile.h"
+#include "tclPort.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)
 
 /*
@@ -33,387 +32,259 @@ 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
-                                 * TclSubstTokens() from a literal text
-                                 * where bs+nl sequences occured in it, if
-                                 * any. I.e. this table keeps track of
-                                 * invisible and 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)
-    Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
-                                 * that a Tcl_Obj was not allocated by some
-                                 * other thread. */
-#endif /* TCL_MEM_DEBUG && TCL_THREADS */
+  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.
+			     */
 } ThreadSpecificData;
 
 static Tcl_ThreadDataKey dataKey;
 
-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
-#elif HAVE_FAST_TSD
-static __thread PendingObjData pendingObjData;
-#define ObjInitDeletionContext(contextPtr) \
-    PendingObjData *const contextPtr = &pendingObjData
-#else
-static Tcl_ThreadDataKey pendingObjDataKey;
-#define ObjInitDeletionContext(contextPtr) \
-    PendingObjData *const contextPtr =                                  \
-	    Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
+static void ContLineLocFree _ANSI_ARGS_((char* clientData));
+static void TclThreadFinalizeObjects _ANSI_ARGS_((ClientData clientData));
+static ThreadSpecificData* TclGetContinuationTable _ANSI_ARGS_(());
 #endif
 
 /*
- * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
+ * Prototypes for procedures defined later in this file:
  */
 
-#define PACK_BIGNUM(bignum, objPtr) \
-    if ((bignum).used > 0x7fff) {                                       \
-	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int));     \
-	*temp = bignum;                                                 \
-	(objPtr)->internalRep.ptrAndLongRep.ptr = 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));            \
-    }
+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 UNPACK_BIGNUM(objPtr, bignum) \
-    if ((objPtr)->internalRep.ptrAndLongRep.value == (unsigned long)(-1)) { \
-	(bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
-    } else {                                                            \
-	(bignum).dp = (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; \
-    }
-
-/*
- * 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);
+#ifndef TCL_WIDE_INT_IS_LONG
+static void		UpdateStringOfWideInt _ANSI_ARGS_((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(Tcl_HashTable *tablePtr, void *keyPtr);
+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));
 
 /*
  * Prototypes for the CommandName object type.
  */
 
-static void		DupCmdNameInternalRep(Tcl_Obj *objPtr,
-			    Tcl_Obj *copyPtr);
-static void		FreeCmdNameInternalRep(Tcl_Obj *objPtr);
-static int		SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+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));
+
 
 /*
  * The structures below defines the Tcl object types defined in this file by
- * means of functions that can be invoked by generic object code. See also
+ * means of procedures that can be invoked by generic object code. See also
  * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
  * implementations.
  */
 
-static const Tcl_ObjType oldBooleanType = {
-    "boolean",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    SetBooleanFromAny		/* setFromAnyProc */
+Tcl_ObjType tclBooleanType = {
+    "boolean",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    UpdateStringOfBoolean,		/* updateStringProc */
+    SetBooleanFromAny			/* setFromAnyProc */
 };
-const Tcl_ObjType tclBooleanType = {
-    "booleanString",		/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    SetBooleanFromAny		/* setFromAnyProc */
-};
-const Tcl_ObjType tclDoubleType = {
-    "double",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    UpdateStringOfDouble,	/* updateStringProc */
-    SetDoubleFromAny		/* setFromAnyProc */
-};
-const Tcl_ObjType tclIntType = {
-    "int",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    UpdateStringOfInt,		/* updateStringProc */
-    SetIntFromAny		/* setFromAnyProc */
+
+Tcl_ObjType tclDoubleType = {
+    "double",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    UpdateStringOfDouble,		/* updateStringProc */
+    SetDoubleFromAny			/* setFromAnyProc */
 };
-#ifndef NO_WIDE_TYPE
-const Tcl_ObjType tclWideIntType = {
-    "wideInt",			/* name */
-    NULL,			/* freeIntRepProc */
-    NULL,			/* dupIntRepProc */
-    UpdateStringOfWideInt,	/* updateStringProc */
-    SetWideIntFromAny		/* setFromAnyProc */
+
+Tcl_ObjType tclIntType = {
+    "int",				/* name */
+    (Tcl_FreeInternalRepProc *) NULL,   /* freeIntRepProc */
+    (Tcl_DupInternalRepProc *) NULL,	/* dupIntRepProc */
+    UpdateStringOfInt,			/* updateStringProc */
+    SetIntFromAny			/* setFromAnyProc */
 };
+
+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 */
+    UpdateStringOfWideInt,		/* updateStringProc */
 #endif
-const Tcl_ObjType tclBignumType = {
-    "bignum",			/* name */
-    FreeBignum,			/* freeIntRepProc */
-    DupBignum,			/* dupIntRepProc */
-    UpdateStringOfBignum,	/* updateStringProc */
-    NULL			/* setFromAnyProc */
+    SetWideIntFromAny			/* setFromAnyProc */
 };
 
 /*
  * The structure below defines the Tcl obj hash key type.
  */
-
-const Tcl_HashKeyType tclObjHashKeyType = {
-    TCL_HASH_KEY_TYPE_VERSION,	/* version */
-    0,				/* flags */
-    TclHashObjKey,		/* hashKeyProc */
-    TclCompareObjKeys,		/* compareKeysProc */
-    AllocObjEntry,		/* allocEntryProc */
-    TclFreeObjEntry		/* freeEntryProc */
+Tcl_HashKeyType tclObjHashKeyType = {
+    TCL_HASH_KEY_TYPE_VERSION,		/* version */
+    0,					/* flags */
+    HashObjKey,				/* hashKeyProc */
+    CompareObjKeys,			/* compareKeysProc */
+    AllocObjEntry,			/* allocEntryProc */
+    FreeObjEntry			/* freeEntryProc */
 };
 
 /*
  * The structure below defines the command name Tcl object type by means of
- * 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.
+ * 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.
  *
  * 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.
- *
- * TRICKY POINT! Some extensions update this structure! (Notably, these
- * include TclBlend and TCom). This is highly ill-advised on their part, but
- * does allow them to delete a command when references to it are gone, which
- * is fragile but useful given their somewhat-OO style. Because of this, this
- * structure MUST NOT be const so that the C compiler puts the data in
- * writable memory. [Bug 2558422]
- * TODO: Provide a better API for those extensions so that they can coexist...
- */
-
-Tcl_ObjType tclCmdNameType = {
-    "cmdName",			/* name */
-    FreeCmdNameInternalRep,	/* freeIntRepProc */
-    DupCmdNameInternalRep,	/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    SetCmdNameFromAny		/* setFromAnyProc */
+ * 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 */
+    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). NULL if the name
-				 * is fully qualified.*/
+				 * reference (not the namespace that
+				 * contains the referenced command). */
     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 function is invoked to perform once-only initialization of the
- *	type table. It also registers the object types defined in this file.
+ *	This procedure 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(void)
+TclInitObjSubsystem()
 {
     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);
@@ -421,8 +292,7 @@ TclInitObjSubsystem(void)
     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;
 	}
     }
@@ -433,53 +303,10 @@ TclInitObjSubsystem(void)
 /*
  *----------------------------------------------------------------------
  *
- * 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(objData);
-	    }
-	}
-
-	Tcl_DeleteHashTable(tablePtr);
-	ckfree(tablePtr);
-	tsdPtr->objThreadMap = NULL;
-    }
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclFinalizeObjects --
  *
- *	This function is called by Tcl_Finalize to clean up all registered
- *	Tcl_ObjType's and to reset the tclFreeObjList.
+ *	This procedure is called by Tcl_Finalize to clean up all
+ *	registered Tcl_ObjType's and to reset the tclFreeObjList.
  *
  * Results:
  *	None.
@@ -491,36 +318,37 @@ TclFinalizeThreadObjects(void)
  */
 
 void
-TclFinalizeObjects(void)
+TclFinalizeObjects()
 {
     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
 /*
  *----------------------------------------------------------------------
  *
- * TclGetContLineTable --
+ * TclGetContinuationTable --
  *
  *	This procedure is a helper which returns the thread-specific
  *	hash-table used to track continuation line information associated with
- *	Tcl_Obj*, and the objThreadMap, etc.
+ *	Tcl_Obj*.
  *
  * Results:
- *	A reference to the thread-data.
+ *	A reference to the continuation line thread-data.
  *
  * Side effects:
  *	May allocate memory for the thread-data.
@@ -529,8 +357,8 @@ TclFinalizeObjects(void)
  *----------------------------------------------------------------------
  */
 
-static ThreadSpecificData *
-TclGetContLineTable(void)
+static ThreadSpecificData*
+TclGetContinuationTable()
 {
     /*
      * Initialize the hashtable tracking invisible continuation lines.  For
@@ -541,11 +369,10 @@ TclGetContLineTable(void)
      */
 
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
     if (!tsdPtr->lineCLPtr) {
-	tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
+	tsdPtr->lineCLPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
 	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
-	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
+	Tcl_CreateThreadExitHandler (TclThreadFinalizeObjects,NULL);
     }
     return tsdPtr;
 }
@@ -568,49 +395,37 @@ TclGetContLineTable(void)
  *----------------------------------------------------------------------
  */
 
-ContLineLoc *
-TclContinuationsEnter(
-    Tcl_Obj *objPtr,
-    int num,
-    int *loc)
+ContLineLoc*
+TclContinuationsEnter(objPtr,num,loc)
+     Tcl_Obj* objPtr;
+     int num;
+     int* loc;
 {
-    int newEntry;
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
-    ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
+  int newEntry;
+  ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+  Tcl_HashEntry* hPtr =
+    Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);
+
+  ContLineLoc* clLocPtr = 
+    (ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));
 
     if (!newEntry) {
 	/*
-	 * 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 would rebase them a second time, or
-	 * more, hosing the data. It is easier to simply replace, as we are
-	 * doing.
+	 * 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.
 	 */
 
-	ckfree(Tcl_GetHashValue(hPtr));
+	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;
 }
 
 /*
@@ -633,22 +448,19 @@ TclContinuationsEnter(
  */
 
 void
-TclContinuationsEnterDerived(
-    Tcl_Obj *objPtr,
-    int start,
-    int *clNext)
+TclContinuationsEnterDerived(objPtr, start, clNext)
+     Tcl_Obj* objPtr;
+     int start;
+     int* clNext;
 {
-    int length, end, num;
-    int *wordCLLast = clNext;
-
     /*
      * We have to handle invisible continuations lines here as well, despite
-     * 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.
+     * 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.
      *
      * 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
@@ -661,15 +473,20 @@ TclContinuationsEnterDerived(
      */
 
     /*
-     * First compute the range of the word within the script. (Is there a
-     * better way which doesn't shimmer?)
+     * First compute the range of the word within the script.
      */
 
+    int length, end, num;
+    int* wordCLLast = clNext;
+
     Tcl_GetStringFromObj(objPtr, &length);
-    end = start + length;       /* First char after the word */
+    /* Is there a better way which doesn't shimmer ? */
+
+    end = start + length; /* first char after the word */
 
     /*
-     * Then compute the table slice covering the range of the word.
+     * Then compute the table slice covering the range of
+     * the word.
      */
 
     while (*wordCLLast >= 0 && *wordCLLast < end) {
@@ -677,19 +494,21 @@ TclContinuationsEnterDerived(
     }
 
     /*
-     * And generate the table from the slice, if it was not empty.
+     * And generate the table from the slice, if it was
+     * not empty.
      */
 
     num = wordCLLast - clNext;
     if (num) {
 	int i;
-	ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
+	ContLineLoc* clLocPtr =
+	    TclContinuationsEnter(objPtr, num, clNext);
 
 	/*
 	 * Re-base the locations.
 	 */
 
-	for (i=0 ; i<num ; i++) {
+	for (i=0;i<num;i++) {
 	    clLocPtr->loc[i] -= start;
 
 	    /*
@@ -711,9 +530,9 @@ TclContinuationsEnterDerived(
  * TclContinuationsCopy --
  *
  *	This procedure is a helper which copies the continuation line
- *	information associated with a Tcl_Obj* to another Tcl_Obj*. It is
- *	assumed that both contain the same string/script. Use this when a
- *	script is duplicated because it was shared.
+ *	information associated with a Tcl_Obj* to another Tcl_Obj*.
+ *	It is assumed that both contain the same string/script. Use
+ *	this when a script is duplicated because it was shared.
  *
  * Results:
  *	None.
@@ -726,16 +545,13 @@ TclContinuationsEnterDerived(
  */
 
 void
-TclContinuationsCopy(
-    Tcl_Obj *objPtr,
-    Tcl_Obj *originObjPtr)
+TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
 {
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-            Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
+    ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) originObjPtr);
 
     if (hPtr) {
-	ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
+	ContLineLoc* clLocPtr = (ContLineLoc*) Tcl_GetHashValue (hPtr);
 
 	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
     }
@@ -750,8 +566,8 @@ TclContinuationsCopy(
  *	information associated with a Tcl_Obj*, if it has any.
  *
  * Results:
- *	A reference to the continuation line location table, or NULL if the
- *	Tcl_Obj* has no such information associated with it.
+ *	A reference to the continuation line location table, or NULL
+ *	if the Tcl_Obj* has no such information associated with it.
  *
  * Side effects:
  *	None.
@@ -760,24 +576,24 @@ TclContinuationsCopy(
  *----------------------------------------------------------------------
  */
 
-ContLineLoc *
-TclContinuationsGet(
-    Tcl_Obj *objPtr)
+ContLineLoc*
+TclContinuationsGet(objPtr)
+     Tcl_Obj* objPtr;
 {
-    ThreadSpecificData *tsdPtr = TclGetContLineTable();
-    Tcl_HashEntry *hPtr =
-            Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+    ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) objPtr);
 
-    if (!hPtr) {
-        return NULL;
+    if (hPtr) {
+	return (ContLineLoc*) Tcl_GetHashValue (hPtr);
+    } else {
+	return NULL;
     }
-    return Tcl_GetHashValue(hPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclThreadFinalizeContLines --
+ * TclThreadFinalizeObjects --
  *
  *	This procedure is a helper which releases all continuation line
  *	information currently known. It is run as a thread exit handler.
@@ -793,31 +609,31 @@ TclContinuationsGet(
  */
 
 static void
-TclThreadFinalizeContLines(
-    ClientData clientData)
+TclThreadFinalizeObjects (clientData)
+     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)) {
+	 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);
+	ContLineLocFree (Tcl_GetHashValue (hPtr));
+	Tcl_DeleteHashEntry (hPtr);
     }
-    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
-    ckfree(tsdPtr->lineCLPtr);
+    Tcl_DeleteHashTable (tsdPtr->lineCLPtr);
     tsdPtr->lineCLPtr = NULL;
 }
 
@@ -839,42 +655,41 @@ TclThreadFinalizeContLines(
  */
 
 static void
-ContLineLocFree(
-    char *clientData)
+ContLineLocFree (clientData)
+     char* clientData;
 {
-    ckfree(clientData);
+  ckfree (clientData);
 }
-
+#endif
 /*
  *--------------------------------------------------------------
  *
  * Tcl_RegisterObjType --
  *
- *	This function is called to register a new Tcl object type in the table
- *	of all object types supported by Tcl.
+ *	This procedure 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(
-    const Tcl_ObjType *typePtr)	/* Information about object type; storage must
-				 * be statically allocated (must live
-				 * forever). */
+Tcl_RegisterObjType(typePtr)
+    Tcl_ObjType *typePtr;	/* Information about object type;
+				 * storage must be statically
+				 * allocated (must live forever). */
 {
-    int isNew;
-
+    int new;
     Tcl_MutexLock(&tableMutex);
     Tcl_SetHashValue(
-	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
+	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &new), typePtr);
     Tcl_MutexUnlock(&tableMutex);
 }
 
@@ -883,54 +698,56 @@ Tcl_RegisterObjType(
  *
  * Tcl_AppendAllObjTypes --
  *
- *	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.
+ *	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.
  *
  * 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(
-    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(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. */
 {
     register Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
-    int numElems;
+    int objc;
+    Tcl_Obj **objv;
 
     /*
      * Get the test for a valid list out of the way first.
      */
 
-    if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) {
+    if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != 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;
@@ -941,11 +758,12 @@ Tcl_AppendAllObjTypes(
  *
  * Tcl_GetObjType --
  *
- *	This function looks up an object type by name.
+ *	This procedure 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.
@@ -953,17 +771,17 @@ Tcl_AppendAllObjTypes(
  *----------------------------------------------------------------------
  */
 
-const Tcl_ObjType *
-Tcl_GetObjType(
-    const char *typeName)	/* Name of Tcl object type to look up. */
+Tcl_ObjType *
+Tcl_GetObjType(typeName)
+    CONST char *typeName;	/* Name of Tcl object type to look up. */
 {
     register Tcl_HashEntry *hPtr;
-    const Tcl_ObjType *typePtr = NULL;
+    Tcl_ObjType *typePtr = NULL;
 
     Tcl_MutexLock(&tableMutex);
     hPtr = Tcl_FindHashEntry(&typeTable, typeName);
-    if (hPtr != NULL) {
-	typePtr = Tcl_GetHashValue(hPtr);
+    if (hPtr != (Tcl_HashEntry *) NULL) {
+        typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
     }
     Tcl_MutexUnlock(&tableMutex);
     return typePtr;
@@ -978,10 +796,10 @@ Tcl_GetObjType(
  *
  * 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
- *	function 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 procedure 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.
@@ -990,168 +808,46 @@ Tcl_GetObjType(
  */
 
 int
-Tcl_ConvertToType(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,		/* The object to convert. */
-    const Tcl_ObjType *typePtr)	/* The target type. */
+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. */
 {
     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 = ckalloc(sizeof(Tcl_HashTable));
-	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
-	}
-	tablePtr = tsdPtr->objThreadMap;
-	hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
-	if (!isNew) {
-	    Tcl_Panic("expected to create new entry for object map");
-	}
-
-	/*
-	 * Record the debugging information.
-	 */
-
-	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 function is normally called when not debugging: i.e., when
+ *	This procedure 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 function just returns the result
- *	of calling the debugging version Tcl_DbNewObj.
+ *	When TCL_MEM_DEBUG is defined, this procedure 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 function increments the
- *	global count of allocated objects (tclObjsAlloced).
+ *	If compiling with TCL_COMPILE_STATS, this procedure increments
+ *	the global count of allocated objects (tclObjsAlloced).
  *
  *----------------------------------------------------------------------
  */
@@ -1160,7 +856,7 @@ TclDbInitNewObj(
 #undef Tcl_NewObj
 
 Tcl_Obj *
-Tcl_NewObj(void)
+Tcl_NewObj()
 {
     return Tcl_DbNewObj("unknown", 0);
 }
@@ -1168,12 +864,13 @@ Tcl_NewObj(void)
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewObj(void)
+Tcl_NewObj()
 {
     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);
@@ -1186,24 +883,24 @@ Tcl_NewObj(void)
  *
  * Tcl_DbNewObj --
  *
- *	This function is normally called when debugging: i.e., when
+ *	This procedure 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 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
+ *	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
  *	number when reporting objects that haven't been freed.
  *
- *	When TCL_MEM_DEBUG is not defined, this function just returns the
+ *	When TCL_MEM_DEBUG is not defined, this procedure 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 function increments the
- *	global count of allocated objects (tclObjsAlloced).
+ *	If compiling with TCL_COMPILE_STATS, this procedure increments
+ *	the global count of allocated objects (tclObjsAlloced).
  *
  *----------------------------------------------------------------------
  */
@@ -1211,16 +908,17 @@ Tcl_NewObj(void)
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-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. */
+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. */
 {
     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);
@@ -1229,11 +927,11 @@ Tcl_DbNewObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-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. */
+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. */
 {
     return Tcl_NewObj();
 }
@@ -1244,8 +942,8 @@ Tcl_DbNewObj(
  *
  * TclAllocateFreeObjects --
  *
- *	Function to allocate a number of free Tcl_Objs. This is done using a
- *	single ckalloc to reduce the overhead for Tcl_Obj allocation.
+ *	Procedure 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.
  *
@@ -1263,7 +961,7 @@ Tcl_DbNewObj(
 #define OBJS_TO_ALLOC_EACH_TIME 100
 
 void
-TclAllocateFreeObjects(void)
+TclAllocateFreeObjects()
 {
     size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
     char *basePtr;
@@ -1271,20 +969,22 @@ TclAllocateFreeObjects(void)
     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 finalization 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 finalziation to
+     * release it.  Purify apparently can't figure that out, and fires a
+     * false alarm.
      */
 
-    basePtr = ckalloc(bytesToAlloc);
+    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 = prevPtr;
+	objPtr->internalRep.otherValuePtr = (VOID *) prevPtr;
 	prevPtr = objPtr;
 	objPtr++;
     }
@@ -1297,220 +997,87 @@ TclAllocateFreeObjects(void)
  *
  * TclFreeObj --
  *
- *	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.
+ *	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.
  *
  * 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 function
- *	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 procedure increments the global count of freed objects
+ *	(tclObjsFreed).
  *
  *----------------------------------------------------------------------
  */
 
-#ifdef TCL_MEM_DEBUG
 void
-TclFreeObj(
-    register Tcl_Obj *objPtr)	/* The object to be freed. */
+TclFreeObj(objPtr)
+    register Tcl_Obj *objPtr;	/* The object to be freed. */
 {
-    register const Tcl_ObjType *typePtr = objPtr->typePtr;
-
-    /*
-     * This macro declares a variable, so must come here...
-     */
-
-    ObjInitDeletionContext(context);
-
-    if (objPtr->refCount < -1) {
-	Tcl_Panic("Reference count for %p was negative", objPtr);
+    register Tcl_ObjType *typePtr = objPtr->typePtr;
+    
+#ifdef TCL_MEM_DEBUG
+    if ((objPtr)->refCount < -1) {
+	panic("Reference count for %lx was negative", objPtr);
     }
+#endif /* TCL_MEM_DEBUG */
 
-    /*
-     * 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(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(objToFree);
-	    Tcl_MutexUnlock(&tclObjMutex);
-	    TclIncrObjsFreed();
-	}
-	ObjDeletionUnlock(context);
+    TCL_DTRACE_OBJ_FREE(objPtr);
+    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	typePtr->freeIntRepProc(objPtr);
     }
+    Tcl_InvalidateStringRep(objPtr);
 
     /*
-     * 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 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.
      */
 
-    {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-        Tcl_HashEntry *hPtr;
-
-	if (tsdPtr->lineCLPtr) {
-            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, 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);
-	}
-    }
+#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 */
 
+#ifdef TCL_TIP280
     /*
      * 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).
+     * 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).
      */
 
     {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-        Tcl_HashEntry *hPtr;
-
+	ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
 	if (tsdPtr->lineCLPtr) {
-            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+	    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
 	    if (hPtr) {
-		Tcl_EventuallyFree(Tcl_GetHashValue(hPtr), ContLineLocFree);
-		Tcl_DeleteHashEntry(hPtr);
+		Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
+		Tcl_DeleteHashEntry (hPtr);
 	    }
 	}
     }
-}
-#endif /* TCL_MEM_DEBUG */
-
-/*
- *----------------------------------------------------------------------
- *
- * 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);
+#endif
+    TclIncrObjsFreed();
 }
 
 /*
@@ -1522,67 +1089,50 @@ TclObjBeingDeleted(
  *	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.
  *
  *----------------------------------------------------------------------
  */
 
-#define SetDuplicateObj(dupPtr, objPtr)					\
-    {									\
-	const Tcl_ObjType *typePtr = (objPtr)->typePtr;			\
-	const char *bytes = (objPtr)->bytes;				\
-	if (bytes) {							\
-	    TclInitStringRep((dupPtr), bytes, (objPtr)->length);	\
-	} else {							\
-	    (dupPtr)->bytes = NULL;					\
-	}								\
-	if (typePtr) {							\
-	    if (typePtr->dupIntRepProc) {				\
-		typePtr->dupIntRepProc((objPtr), (dupPtr));		\
-	    } else {							\
-		(dupPtr)->internalRep = (objPtr)->internalRep;		\
-		(dupPtr)->typePtr = typePtr;				\
-	    }								\
-	}								\
-    }
-
 Tcl_Obj *
-Tcl_DuplicateObj(
-    Tcl_Obj *objPtr)		/* The object to duplicate. */
+Tcl_DuplicateObj(objPtr)
+    register Tcl_Obj *objPtr;		/* The object to duplicate. */
 {
-    Tcl_Obj *dupPtr;
+    register Tcl_ObjType *typePtr = objPtr->typePtr;
+    register Tcl_Obj *dupPtr;
 
     TclNewObj(dupPtr);
-    SetDuplicateObj(dupPtr, objPtr);
-    return dupPtr;
-}
 
-void
-TclSetDuplicateObj(
-    Tcl_Obj *dupPtr,
-    Tcl_Obj *objPtr)
-{
-    if (Tcl_IsShared(dupPtr)) {
-	Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
+    if (objPtr->bytes == NULL) {
+	dupPtr->bytes = NULL;
+    } else if (objPtr->bytes != tclEmptyStringRep) {
+	TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length);
+    }
+    
+    if (typePtr != NULL) {
+	if (typePtr->dupIntRepProc == NULL) {
+	    dupPtr->internalRep = objPtr->internalRep;
+	    dupPtr->typePtr = typePtr;
+	} else {
+	    (*typePtr->dupIntRepProc)(objPtr, dupPtr);
+	}
     }
-    TclInvalidateStringRep(dupPtr);
-    TclFreeIntRep(dupPtr);
-    SetDuplicateObj(dupPtr, objPtr);
+    return dupPtr;
 }
 
 /*
@@ -1607,37 +1157,19 @@ TclSetDuplicateObj(
  */
 
 char *
-Tcl_GetString(
-    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
-				 * be returned. */
+Tcl_GetString(objPtr)
+    register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
+				 * should be returned. */
 {
     if (objPtr->bytes != NULL) {
 	return objPtr->bytes;
     }
 
-    /*
-     * Note we do not check for objPtr->typePtr == NULL.  An invariant of
-     * a properly maintained Tcl_Obj is that at least  one of objPtr->bytes
-     * and objPtr->typePtr must not be NULL.  If broken extensions fail to
-     * maintain that invariant, we can crash here.
-     */
-
     if (objPtr->typePtr->updateStringProc == NULL) {
-	/*
-	 * Those Tcl_ObjTypes which choose not to define an updateStringProc
-	 * must be written in such a way that (objPtr->bytes) never becomes
-	 * NULL.  This panic was added in Tcl 8.1.
-	 */
-
-	Tcl_Panic("UpdateStringProc should not be invoked for type %s",
+	panic("UpdateStringProc should not be invoked for type %s",
 		objPtr->typePtr->name);
     }
-    objPtr->typePtr->updateStringProc(objPtr);
-    if (objPtr->bytes == NULL || objPtr->length < 0
-	    || objPtr->bytes[objPtr->length] != '\0') {
-	Tcl_Panic("UpdateStringProc for type '%s' "
-		"failed to create a valid string rep", objPtr->typePtr->name);
-    }
+    (*objPtr->typePtr->updateStringProc)(objPtr);
     return objPtr->bytes;
 }
 
@@ -1646,16 +1178,16 @@ Tcl_GetString(
  *
  * 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
@@ -1665,14 +1197,20 @@ Tcl_GetString(
  */
 
 char *
-Tcl_GetStringFromObj(
-    register Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
+Tcl_GetStringFromObj(objPtr, lengthPtr)
+    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. */
 {
-    (void) TclGetString(objPtr);
+    if (objPtr->bytes == NULL) {
+	if (objPtr->typePtr->updateStringProc == NULL) {
+	    panic("UpdateStringProc should not be invoked for type %s",
+		    objPtr->typePtr->name);
+	}
+	(*objPtr->typePtr->updateStringProc)(objPtr);
+    }
 
     if (lengthPtr != NULL) {
 	*lengthPtr = objPtr->length;
@@ -1685,25 +1223,30 @@ Tcl_GetStringFromObj(
  *
  * Tcl_InvalidateStringRep --
  *
- *	This function is called to invalidate an object's string
- *	representation.
+ *	This procedure 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(
-    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
-				 * be freed. */
+Tcl_InvalidateStringRep(objPtr)
+     register Tcl_Obj *objPtr;	/* Object whose string rep byte pointer
+				 * should be freed. */
 {
-    TclInvalidateStringRep(objPtr);
+    if (objPtr->bytes != NULL) {
+	if (objPtr->bytes != tclEmptyStringRep) {
+	    ckfree((char *) objPtr->bytes);
+	}
+	objPtr->bytes = NULL;
+    }
 }
 
 /*
@@ -1711,17 +1254,17 @@ Tcl_InvalidateStringRep(
  *
  * Tcl_NewBooleanObj --
  *
- *	This function is normally called when not debugging: i.e., when
+ *	This procedure 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 function just returns the result
- *	of calling the debugging version Tcl_DbNewBooleanObj.
+ *	When TCL_MEM_DEBUG is defined, this procedure 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.
@@ -1733,8 +1276,8 @@ Tcl_InvalidateStringRep(
 #undef Tcl_NewBooleanObj
 
 Tcl_Obj *
-Tcl_NewBooleanObj(
-    register int boolValue)	/* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(boolValue)
+    register int boolValue;	/* Boolean used to initialize new object. */
 {
     return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
 }
@@ -1742,12 +1285,16 @@ Tcl_NewBooleanObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewBooleanObj(
-    register int boolValue)	/* Boolean used to initialize new object. */
+Tcl_NewBooleanObj(boolValue)
+    register int boolValue;	/* Boolean used to initialize new object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewBooleanObj(objPtr, boolValue);
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
     return objPtr;
 }
 #endif /* TCL_MEM_DEBUG */
@@ -1757,20 +1304,20 @@ Tcl_NewBooleanObj(
  *
  * Tcl_DbNewBooleanObj --
  *
- *	This function is normally called when debugging: i.e., when
+ *	This procedure 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 function above except that it calls
+ *	same as the Tcl_NewBooleanObj 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 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 function just returns the
+ *	When TCL_MEM_DEBUG is not defined, this procedure 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.
@@ -1781,32 +1328,32 @@ Tcl_NewBooleanObj(
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-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. */
+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. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
     objPtr->bytes = NULL;
-
+    
     objPtr->internalRep.longValue = (boolValue? 1 : 0);
-    objPtr->typePtr = &tclIntType;
+    objPtr->typePtr = &tclBooleanType;
     return objPtr;
 }
 
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-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. */
+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. */
 {
     return Tcl_NewBooleanObj(boolValue);
 }
@@ -1824,22 +1371,30 @@ Tcl_DbNewBooleanObj(
  *	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(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register int boolValue)	/* Boolean used to set object's value. */
+Tcl_SetBooleanObj(objPtr, boolValue)
+    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)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
+	panic("Tcl_SetBooleanObj called with shared object");
     }
-
-    TclSetBooleanObj(objPtr, boolValue);
+    
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = (boolValue? 1 : 0);
+    objPtr->typePtr = &tclBooleanType;
+    Tcl_InvalidateStringRep(objPtr);
 }
 
 /*
@@ -1847,8 +1402,9 @@ Tcl_SetBooleanObj(
  *
  * Tcl_GetBooleanFromObj --
  *
- *	Attempt to return a boolean from the Tcl object "objPtr". This
- *	includes conversion from any of Tcl's numeric types.
+ *	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.
  *
  * Results:
  *	The return value is a standard Tcl object result. If an error occurs
@@ -1856,56 +1412,30 @@ Tcl_SetBooleanObj(
  *	result unless "interp" is NULL.
  *
  * Side effects:
- *	The intrep of *objPtr may be changed.
+ *	If the object is not already a boolean, the conversion will free
+ *	any old internal representation. 
  *
  *----------------------------------------------------------------------
  */
 
 int
-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. */
+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. */
 {
-    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.
-	     */
+    register int result;
 
-	    double d;
+    if (objPtr->typePtr == &tclBooleanType) {
+	result = TCL_OK;
+    } else {
+	result = SetBooleanFromAny(interp, objPtr);
+    }
 
-	    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;
+    if (result == TCL_OK) {
+	*boolPtr = (int) objPtr->internalRep.longValue;
+    }
+    return result;
 }
 
 /*
@@ -1922,180 +1452,218 @@ Tcl_GetBooleanFromObj(
  *	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(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
-{
+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;
+
     /*
-     * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
-     * whether a boolean conversion is possible without generating the string
-     * rep.
+     * Get the string representation. Make it up-to-date if necessary.
      */
-
-    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;
-	const 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);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
-    }
-    return TCL_ERROR;
-}
-
-static int
-ParseBoolean(
-    register Tcl_Obj *objPtr)	/* The object to parse/convert. */
-{
-    int i, length, newBool;
-    char lowerCase[6];
-    const char *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;
-    }
+    
+    string = Tcl_GetStringFromObj(objPtr, &length);
 
     /*
-     * Force to lower case for case-insensitive detection. Filter out known
-     * invalid characters at the same time.
+     * Use the obvious shortcuts for numerical values; if objPtr is not
+     * of numerical type, parse its string rep.
      */
-
-    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':
+	
+    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));
+	    }
 	    lowerCase[i] = c;
-	    break;
-	default:
-	    return TCL_ERROR;
 	}
-    }
-    lowerCase[length] = 0;
-    switch (lowerCase[0]) {
-    case 'y':
+	lowerCase[i] = 0;
+	
 	/*
-	 * Checking the 'y' is redundant, but makes the code clearer.
+	 * Parse the string as a boolean. We use an implementation here that
+	 * doesn't report errors in interp if interp is NULL.
 	 */
-	if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
-	    newBool = 1;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 'n':
-	if (strncmp(lowerCase, "no", (size_t) length) == 0) {
+	
+	c = lowerCase[0];
+	if ((c == '0') && (lowerCase[1] == '\0')) {
 	    newBool = 0;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 't':
-	if (strncmp(lowerCase, "true", (size_t) length) == 0) {
+	} else if ((c == '1') && (lowerCase[1] == '\0')) {
 	    newBool = 1;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 'f':
-	if (strncmp(lowerCase, "false", (size_t) length) == 0) {
+	} else if ((c == 'y') && (strncmp(lowerCase, "yes", (size_t) length) == 0)) {
+	    newBool = 1;
+	} else if ((c == 'n') && (strncmp(lowerCase, "no", (size_t) length) == 0)) {
 	    newBool = 0;
-	    goto goodBoolean;
-	}
-	return TCL_ERROR;
-    case 'o':
-	if (length < 2) {
-	    return TCL_ERROR;
-	}
-	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+	} else if ((c == 't') && (strncmp(lowerCase, "true", (size_t) length) == 0)) {
 	    newBool = 1;
-	    goto goodBoolean;
-	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+	} else if ((c == 'f') && (strncmp(lowerCase, "false", (size_t) length) == 0)) {
 	    newBool = 0;
-	    goto goodBoolean;
+	} 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);
 	}
-	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:
-    TclFreeIntRep(objPtr);
+    goodBoolean:
+    if ((oldTypePtr != NULL) &&	(oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+
     objPtr->internalRep.longValue = newBool;
     objPtr->typePtr = &tclBooleanType;
     return TCL_OK;
 
-  numericBoolean:
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.longValue = newBool;
-    objPtr->typePtr = &tclIntType;
-    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;
 }
 
 /*
@@ -2103,12 +1671,12 @@ ParseBoolean(
  *
  * Tcl_NewDoubleObj --
  *
- *	This function is normally called when not debugging: i.e., when
+ *	This procedure 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 function just returns the result
- *	of calling the debugging version Tcl_DbNewDoubleObj.
+ *	When TCL_MEM_DEBUG is defined, this procedure just returns the
+ *	result of calling the debugging version Tcl_DbNewDoubleObj.
  *
  * Results:
  *	The newly created object is returned. This object will have an
@@ -2124,8 +1692,8 @@ ParseBoolean(
 #undef Tcl_NewDoubleObj
 
 Tcl_Obj *
-Tcl_NewDoubleObj(
-    register double dblValue)	/* Double used to initialize the object. */
+Tcl_NewDoubleObj(dblValue)
+    register double dblValue;	/* Double used to initialize the object. */
 {
     return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
 }
@@ -2133,12 +1701,16 @@ Tcl_NewDoubleObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewDoubleObj(
-    register double dblValue)	/* Double used to initialize the object. */
+Tcl_NewDoubleObj(dblValue)
+    register double dblValue;	/* Double used to initialize the object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewDoubleObj(objPtr, dblValue);
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -2148,20 +1720,20 @@ Tcl_NewDoubleObj(
  *
  * Tcl_DbNewDoubleObj --
  *
- *	This function is normally called when debugging: i.e., when
+ *	This procedure 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 function above except that it calls
+ *	same as the Tcl_NewDoubleObj 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 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 function just returns the
+ *	When TCL_MEM_DEBUG is not defined, this procedure 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.
@@ -2172,18 +1744,18 @@ Tcl_NewDoubleObj(
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-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. */
+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. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
     objPtr->bytes = NULL;
-
+    
     objPtr->internalRep.doubleValue = dblValue;
     objPtr->typePtr = &tclDoubleType;
     return objPtr;
@@ -2192,12 +1764,12 @@ Tcl_DbNewDoubleObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-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. */
+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. */
 {
     return Tcl_NewDoubleObj(dblValue);
 }
@@ -2215,22 +1787,30 @@ Tcl_DbNewDoubleObj(
  *	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(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register double dblValue)	/* Double used to set the object's value. */
+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. */
 {
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
+	panic("Tcl_SetDoubleObj called with shared object");
     }
 
-    TclSetDoubleObj(objPtr, dblValue);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.doubleValue = dblValue;
+    objPtr->typePtr = &tclDoubleType;
+    Tcl_InvalidateStringRep(objPtr);
 }
 
 /*
@@ -2238,8 +1818,9 @@ Tcl_SetDoubleObj(
  *
  * 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
@@ -2247,51 +1828,30 @@ Tcl_SetDoubleObj(
  *	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(
-    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. */
-{
-    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));
-                    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
-                            NULL);
-		}
-		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;
+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. */
+{
+    register int result;
+    
+    if (objPtr->typePtr == &tclDoubleType) {
+	*dblPtr = objPtr->internalRep.doubleValue;
+	return TCL_OK;
+    }
 
-	    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;
+    result = SetDoubleFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*dblPtr = objPtr->internalRep.doubleValue;
+    }
+    return result;
 }
 
 /*
@@ -2315,12 +1875,78 @@ Tcl_GetDoubleFromObj(
  */
 
 static int
-SetDoubleFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
+SetDoubleFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
 {
-    return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
-	    NULL, 0);
+    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;
 }
 
 /*
@@ -2328,9 +1954,9 @@ SetDoubleFromAny(
  *
  * 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 function 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 procedure does not free an
  *	existing old string rep so storage will be lost if this has not
  *	already been done.
  *
@@ -2338,24 +1964,25 @@ SetDoubleFromAny(
  *	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(
-    register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
+UpdateStringOfDouble(objPtr)
+    register Tcl_Obj *objPtr;	/* Double obj with string rep to update. */
 {
     char buffer[TCL_DOUBLE_SPACE];
     register int len;
-
-    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
+    
+    Tcl_PrintDouble((Tcl_Interp *) NULL, objPtr->internalRep.doubleValue,
+	    buffer);
     len = strlen(buffer);
-
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
+    
+    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
+    strcpy(objPtr->bytes, buffer);
     objPtr->length = len;
 }
 
@@ -2366,22 +1993,22 @@ UpdateStringOfDouble(
  *
  *	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 function Tcl_DbNewLongObj instead.
+ *	debugging procedure 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.
@@ -2393,8 +2020,8 @@ UpdateStringOfDouble(
 #undef Tcl_NewIntObj
 
 Tcl_Obj *
-Tcl_NewIntObj(
-    register int intValue)	/* Int used to initialize the new object. */
+Tcl_NewIntObj(intValue)
+    register int intValue;	/* Int used to initialize the new object. */
 {
     return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
 }
@@ -2402,12 +2029,16 @@ Tcl_NewIntObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewIntObj(
-    register int intValue)	/* Int used to initialize the new object. */
+Tcl_NewIntObj(intValue)
+    register int intValue;	/* Int used to initialize the new object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewIntObj(objPtr, intValue);
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = (long)intValue;
+    objPtr->typePtr = &tclIntType;
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -2424,22 +2055,30 @@ Tcl_NewIntObj(
  *	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(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register int intValue)	/* Integer used to set object's value. */
+Tcl_SetIntObj(objPtr, intValue)
+    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)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
+	panic("Tcl_SetIntObj called with shared object");
     }
-
-    TclSetIntObj(objPtr, intValue);
+    
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = (long) intValue;
+    objPtr->typePtr = &tclIntType;
+    Tcl_InvalidateStringRep(objPtr);
 }
 
 /*
@@ -2452,48 +2091,67 @@ Tcl_SetIntObj(
  *
  *	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(
-    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(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. */
 {
-#if (LONG_MAX == INT_MAX)
-    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
-#else
-    long l;
+    int result;
+    Tcl_WideInt w = 0;
 
-    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
-	return TCL_ERROR;
+    /*
+     * 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;
+	}
     }
-    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
+
+    /*
+     * Object should now be either int or wide. Get its value.
+     */
+
+#ifndef TCL_WIDE_INT_IS_LONG
+    if (objPtr->typePtr == &tclWideIntType) {
+	w = objPtr->internalRep.wideValue;
+    } else
+#endif
+    {
+	w = Tcl_LongAsWide(objPtr->internalRep.longValue);
+    }
+
+    if ((LLONG_MAX > UINT_MAX)
+	    && ((w > UINT_MAX) || (w < -(Tcl_WideInt)UINT_MAX))) {
 	if (interp != NULL) {
-	    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);
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"integer value too large to represent as non-long integer",
+		-1));
 	}
 	return TCL_ERROR;
     }
-    *intPtr = (int) l;
+    *intPtr = (int)w;
     return TCL_OK;
-#endif
 }
 
 /*
@@ -2501,25 +2159,173 @@ Tcl_GetIntFromObj(
  *
  * SetIntFromAny --
  *
- *	Attempts to force the internal representation for a Tcl object to
- *	tclIntType, specifically.
+ *	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".
  *
  * 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
-SetIntFromAny(
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
+SetIntOrWideFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
 {
-    long l;
+    Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+    char *string, *end;
+    int length;
+    register char *p;
+    unsigned long newLong;
+    int isNegative = 0;
+    int isWide = 0;
 
-    return TclGetLongFromObj(interp, objPtr, &l);
+    /*
+     * 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;
 }
 
 /*
@@ -2527,31 +2333,31 @@ SetIntFromAny(
  *
  * UpdateStringOfInt --
  *
- *	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.
+ *	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. 
  *
  * 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(
-    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
+UpdateStringOfInt(objPtr)
+    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(len + 1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
+    
+    objPtr->bytes = ckalloc((unsigned) len + 1);
+    strcpy(objPtr->bytes, buffer);
     objPtr->length = len;
 }
 
@@ -2561,23 +2367,23 @@ UpdateStringOfInt(
  * 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 function Tcl_DbNewLongObj instead.
+ *	Tcl_NewLongObj to create a new long integer object end up calling
+ *	the debugging procedure 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.
@@ -2589,8 +2395,8 @@ UpdateStringOfInt(
 #undef Tcl_NewLongObj
 
 Tcl_Obj *
-Tcl_NewLongObj(
-    register long longValue)	/* Long integer used to initialize the
+Tcl_NewLongObj(longValue)
+    register long longValue;	/* Long integer used to initialize the
 				 * new object. */
 {
     return Tcl_DbNewLongObj(longValue, "unknown", 0);
@@ -2599,13 +2405,17 @@ Tcl_NewLongObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewLongObj(
-    register long longValue)	/* Long integer used to initialize the
+Tcl_NewLongObj(longValue)
+    register long longValue;	/* Long integer used to initialize the
 				 * new object. */
 {
     register Tcl_Obj *objPtr;
 
-    TclNewLongObj(objPtr, longValue);
+    TclNewObj(objPtr);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -2616,25 +2426,26 @@ Tcl_NewLongObj(
  * 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 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.
+ *	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.
  *
  *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
- *	this function just returns the result of calling Tcl_NewLongObj.
+ *	this procedure 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.
@@ -2645,19 +2456,19 @@ Tcl_NewLongObj(
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-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. */
+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. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
     objPtr->bytes = NULL;
-
+    
     objPtr->internalRep.longValue = longValue;
     objPtr->typePtr = &tclIntType;
     return objPtr;
@@ -2666,13 +2477,13 @@ Tcl_DbNewLongObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-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. */
+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. */
 {
     return Tcl_NewLongObj(longValue);
 }
@@ -2690,23 +2501,31 @@ Tcl_DbNewLongObj(
  *	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(
-    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    register long longValue)	/* Long integer used to initialize the
+Tcl_SetLongObj(objPtr, longValue)
+    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)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
+	panic("Tcl_SetLongObj called with shared object");
     }
 
-    TclSetLongObj(objPtr, longValue);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
+    objPtr->internalRep.longValue = longValue;
+    objPtr->typePtr = &tclIntType;
+    Tcl_InvalidateStringRep(objPtr);
 }
 
 /*
@@ -2714,8 +2533,8 @@ Tcl_SetLongObj(
  *
  * 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:
@@ -2731,133 +2550,211 @@ Tcl_SetLongObj(
  */
 
 int
-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. */
+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. */
 {
-    do {
-	if (objPtr->typePtr == &tclIntType) {
-	    *longPtr = objPtr->internalRep.longValue;
-	    return TCL_OK;
+    register int result;
+    
+    if (objPtr->typePtr != &tclIntType && objPtr->typePtr != &tclWideIntType) {
+	result = SetIntOrWideFromAny(interp, objPtr);
+	if (result != TCL_OK) {
+	    return result;
 	}
-#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;
+#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.
+	 */
 
-	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
-		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
-		*longPtr = Tcl_WideAsLong(w);
-		return TCL_OK;
-	    }
-	    goto tooLarge;
-	}
-#endif
-	if (objPtr->typePtr == &tclDoubleType) {
+	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_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        Tcl_GetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+		Tcl_ResetResult(interp);
+		Tcl_AppendToObj(Tcl_GetObjResult(interp),
+			"integer value too large to represent", -1);
 	    }
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr == &tclBignumType) {
+    }
+#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) {
 	    /*
-	     * 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.
+	     * 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;
+    }
+    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;
+    }
 
-	    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
-	    if (interp != NULL) {
-		const char *s = "integer value too large to represent";
-		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
+    /*
+     * 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;
+    }
 
-		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;
+    /*
+     * 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;
+    }
+#endif
+    objPtr->typePtr = &tclWideIntType;
+    return TCL_OK;
 }
-#ifndef NO_WIDE_TYPE
 
 /*
  *----------------------------------------------------------------------
  *
  * UpdateStringOfWideInt --
  *
- *	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.
+ *	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. 
  *
  * 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(
-    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
+UpdateStringOfWideInt(objPtr)
+    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(len + 1);
+    objPtr->bytes = ckalloc((unsigned) len + 1);
     memcpy(objPtr->bytes, buffer, len + 1);
     objPtr->length = len;
 }
-#endif /* !NO_WIDE_TYPE */
+#endif /* TCL_WIDE_INT_IS_LONG */
 
 /*
  *----------------------------------------------------------------------
@@ -2866,17 +2763,17 @@ UpdateStringOfWideInt(
  *
  *	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 function Tcl_DbNewWideIntObj instead.
+ *	the debugging procedure 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.
@@ -2888,10 +2785,9 @@ UpdateStringOfWideInt(
 #undef Tcl_NewWideIntObj
 
 Tcl_Obj *
-Tcl_NewWideIntObj(
-    register Tcl_WideInt wideValue)
-				/* Wide integer used to initialize the new
-				 * object. */
+Tcl_NewWideIntObj(wideValue)
+    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
+					 * the new object. */
 {
     return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
 }
@@ -2899,15 +2795,17 @@ Tcl_NewWideIntObj(
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-Tcl_NewWideIntObj(
-    register Tcl_WideInt wideValue)
-				/* Wide integer used to initialize the new
-				 * object. */
+Tcl_NewWideIntObj(wideValue)
+    register Tcl_WideInt wideValue;	/* Wide integer used to initialize
+					 * the new object. */
 {
     register Tcl_Obj *objPtr;
 
     TclNewObj(objPtr);
-    Tcl_SetWideIntObj(objPtr, wideValue);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.wideValue = wideValue;
+    objPtr->typePtr = &tclWideIntType;
     return objPtr;
 }
 #endif /* if TCL_MEM_DEBUG */
@@ -2918,25 +2816,27 @@ Tcl_NewWideIntObj(
  * 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 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.
+ *	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.
  *
  *	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 function just returns the result of calling Tcl_NewWideIntObj.
+ *	this procedure 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.
@@ -2947,33 +2847,36 @@ Tcl_NewWideIntObj(
 #ifdef TCL_MEM_DEBUG
 
 Tcl_Obj *
-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. */
+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. */
 {
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
-    Tcl_SetWideIntObj(objPtr, wideValue);
+    objPtr->bytes = NULL;
+    
+    objPtr->internalRep.wideValue = wideValue;
+    objPtr->typePtr = &tclWideIntType;
     return objPtr;
 }
 
 #else /* if not TCL_MEM_DEBUG */
 
 Tcl_Obj *
-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. */
+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. */
 {
     return Tcl_NewWideIntObj(wideValue);
 }
@@ -2984,43 +2887,38 @@ Tcl_DbNewWideIntObj(
  *
  * 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(
-    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(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. */
 {
+    register Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
+	panic("Tcl_SetWideIntObj called with shared object");
     }
 
-    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
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
     }
+    
+    objPtr->internalRep.wideValue = wideValue;
+    objPtr->typePtr = &tclWideIntType;
+    Tcl_InvalidateStringRep(objPtr);
 }
 
 /*
@@ -3028,9 +2926,9 @@ Tcl_SetWideIntObj(
  *
  * 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
@@ -3045,618 +2943,33 @@ Tcl_SetWideIntObj(
  */
 
 int
-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. */
-{
-    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_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        Tcl_GetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    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.
-	     */
-
-	    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) {
-		const 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)
+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. */
 {
-    mp_int toFree;		/* Bignum to free */
+    register int result;
 
-    UNPACK_BIGNUM(objPtr, toFree);
-    mp_clear(&toFree);
-    if ((long) objPtr->internalRep.ptrAndLongRep.value < 0) {
-	ckfree(objPtr->internalRep.ptrAndLongRep.ptr);
-    }
-    objPtr->typePtr = NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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");
-    }
-    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 (objPtr->typePtr == &tclWideIntType) {
+    gotWide:
+	*wideIntPtr = objPtr->internalRep.wideValue;
+	return TCL_OK;
     }
-    if (size == 3) {
+    if (objPtr->typePtr == &tclIntType) {
 	/*
-	 * 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.
+	 * This cast is safe; all valid ints/longs are wides.
 	 */
 
-	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
+	objPtr->internalRep.wideValue =
+		Tcl_LongAsWide(objPtr->internalRep.longValue);
+	objPtr->typePtr = &tclWideIntType;
+	goto gotWide;
     }
-    stringVal = ckalloc(size);
-    status = mp_toradix_n(&bignumVal, stringVal, 10, size);
-    if (status != MP_OKAY) {
-	Tcl_Panic("conversion failure in UpdateStringOfBignum");
+    result = SetWideIntFromAny(interp, objPtr);
+    if (result == TCL_OK) {
+	*wideIntPtr = objPtr->internalRep.wideValue;
     }
-    objPtr->bytes = stringVal;
-    objPtr->length = size - 1;	/* size includes a trailing NUL 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_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        Tcl_GetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSetBignumIntRep --
- *
- *	Install a bignum into the internal representation of an object.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Object internal representation is updated and object type is set. The
- *	bignum value is cleared, since ownership has transferred to the
- *	object.
- *
- *----------------------------------------------------------------------
- */
-
-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 --
- *
- *      Extracts a number (of any possible numeric type) from an object.
- *
- * Results:
- *      Whether the extraction worked. The type is stored in the variable
- *      referred to by the typePtr argument, and a pointer to the
- *      representation is stored in the variable referred to by the
- *      clientDataPtr.
- *
- * Side effects:
- *      Can allocate thread-specific data for handling the copy-out space for
- *      bignums; this space is shared within a thread.
- *
- *----------------------------------------------------------------------
- */
-
-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;
+    return result;
 }
 
 /*
@@ -3664,12 +2977,12 @@ TclGetNumberFromObj(
  *
  * Tcl_DbIncrRefCount --
  *
- *	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.
+ *	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.
  *
- *	When TCL_MEM_DEBUG is not defined, this function just increments the
- *	reference count of the object.
+ *	When TCL_MEM_DEBUG is not defined, this procedure just increments
+ *	the reference count of the object.
  *
  * Results:
  *	None.
@@ -3681,44 +2994,21 @@ TclGetNumberFromObj(
  */
 
 void
-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. */
+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. */
 {
 #ifdef TCL_MEM_DEBUG
     if (objPtr->refCount == 0x61616161) {
 	fprintf(stderr, "file = %s, line = %d\n", file, line);
 	fflush(stderr);
-	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()) {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
-	Tcl_HashEntry *hPtr;
-
-	if (!tablePtr) {
-	    Tcl_Panic("object table not initialized");
-	}
-	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
-	if (!hPtr) {
-	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
-                    "incr ref count");
-	}
+	panic("Trying to increment refCount of previously disposed object.");
     }
-# endif /* TCL_THREADS */
-#endif /* TCL_MEM_DEBUG */
+#endif
     ++(objPtr)->refCount;
 }
 
@@ -3727,12 +3017,12 @@ Tcl_DbIncrRefCount(
  *
  * Tcl_DbDecrRefCount --
  *
- *	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.
+ *	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.
  *
- *	When TCL_MEM_DEBUG is not defined, this function just decrements the
- *	reference count of the object.
+ *	When TCL_MEM_DEBUG is not defined, this procedure just decrements
+ *	the reference count of the object.
  *
  * Results:
  *	None.
@@ -3744,59 +3034,21 @@ Tcl_DbIncrRefCount(
  */
 
 void
-Tcl_DbDecrRefCount(
-    register Tcl_Obj *objPtr,	/* The object we are releasing a reference
+Tcl_DbDecrRefCount(objPtr, file, line)
+    register Tcl_Obj *objPtr;	/* The object we are releasing 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. */
+    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. */
 {
 #ifdef TCL_MEM_DEBUG
     if (objPtr->refCount == 0x61616161) {
 	fprintf(stderr, "file = %s, line = %d\n", file, line);
 	fflush(stderr);
-	Tcl_Panic("decrementing refCount of previously disposed object");
+	panic("Trying to decrement 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()) {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
-	Tcl_HashEntry *hPtr;
-
-	if (!tablePtr) {
-	    Tcl_Panic("object table not initialized");
-	}
-	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
-	if (!hPtr) {
-	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
-                    "decr ref count");
-	}
-
-	/*
-	 * 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(objData);
-	    }
-
-	    Tcl_DeleteHashEntry(hPtr);
-	}
-    }
-# endif /* TCL_THREADS */
-#endif /* TCL_MEM_DEBUG */
-
+#endif
     if (--(objPtr)->refCount <= 0) {
 	TclFreeObj(objPtr);
     }
@@ -3807,12 +3059,12 @@ Tcl_DbDecrRefCount(
  *
  * Tcl_DbIsShared --
  *
- *	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.
+ *	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.
  *
- *	When TCL_MEM_DEBUG is not defined, this function just tests if 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.
  *
  * Results:
  *	None.
@@ -3824,44 +3076,20 @@ Tcl_DbDecrRefCount(
  */
 
 int
-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. */
+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. */
 {
 #ifdef TCL_MEM_DEBUG
     if (objPtr->refCount == 0x61616161) {
 	fprintf(stderr, "file = %s, line = %d\n", file, line);
 	fflush(stderr);
-	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()) {
-	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
-	Tcl_HashEntry *hPtr;
-
-	if (!tablePtr) {
-	    Tcl_Panic("object table not initialized");
-	}
-	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
-	if (!hPtr) {
-	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
-                    "check shared status");
-	}
+	panic("Trying to check whether previously disposed object is shared.");
     }
-# endif /* TCL_THREADS */
-#endif /* TCL_MEM_DEBUG */
-
+#endif
 #ifdef TCL_COMPILE_STATS
     Tcl_MutexLock(&tclObjMutex);
     if ((objPtr)->refCount <= 1) {
@@ -3872,8 +3100,7 @@ Tcl_DbIsShared(
 	tclObjsShared[0]++;
     }
     Tcl_MutexUnlock(&tclObjMutex);
-#endif /* TCL_COMPILE_STATS */
-
+#endif
     return ((objPtr)->refCount > 1);
 }
 
@@ -3882,8 +3109,8 @@ Tcl_DbIsShared(
  *
  * 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.
@@ -3896,10 +3123,9 @@ Tcl_DbIsShared(
  */
 
 void
-Tcl_InitObjHashTable(
-    register Tcl_HashTable *tablePtr)
-				/* Pointer to table record, which is supplied
-				 * by the caller. */
+Tcl_InitObjHashTable(tablePtr)
+    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
+					 * is supplied by the caller. */
 {
     Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS,
 	    &tclObjHashKeyType);
@@ -3922,16 +3148,16 @@ Tcl_InitObjHashTable(
  */
 
 static Tcl_HashEntry *
-AllocObjEntry(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key to store in the hash table entry. */
+AllocObjEntry(tablePtr, keyPtr)
+    Tcl_HashTable *tablePtr;	/* Hash table. */
+    VOID *keyPtr;		/* Key to store in the hash table entry. */
 {
-    Tcl_Obj *objPtr = keyPtr;
-    Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
+    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+    Tcl_HashEntry *hPtr;
 
-    hPtr->key.objPtr = objPtr;
-    Tcl_IncrRefCount(objPtr);
-    hPtr->clientData = NULL;
+    hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
+    hPtr->key.oneWordValue = (char *) objPtr;
+    Tcl_IncrRefCount (objPtr);
 
     return hPtr;
 }
@@ -3939,13 +3165,13 @@ AllocObjEntry(
 /*
  *----------------------------------------------------------------------
  *
- * TclCompareObjKeys --
+ * CompareObjKeys --
  *
  *	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.
@@ -3953,20 +3179,19 @@ AllocObjEntry(
  *----------------------------------------------------------------------
  */
 
-int
-TclCompareObjKeys(
-    void *keyPtr,		/* New key to compare. */
-    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
+static int
+CompareObjKeys(keyPtr, hPtr)
+    VOID *keyPtr;		/* New key to compare. */
+    Tcl_HashEntry *hPtr;		/* Existing key to compare. */
 {
-    Tcl_Obj *objPtr1 = keyPtr;
+    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
     Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
-    register const char *p1, *p2;
+    register CONST char *p1, *p2;
     register int l1, l2;
 
     /*
      * If the object pointers are the same then they match.
      */
-
     if (objPtr1 == objPtr2) {
 	return 1;
     }
@@ -3975,16 +3200,14 @@ TclCompareObjKeys(
      * 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) {
@@ -4002,7 +3225,7 @@ TclCompareObjKeys(
 /*
  *----------------------------------------------------------------------
  *
- * TclFreeObjEntry --
+ * FreeObjEntry --
  *
  *	Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
  *
@@ -4015,27 +3238,27 @@ TclCompareObjKeys(
  *----------------------------------------------------------------------
  */
 
-void
-TclFreeObjEntry(
-    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
+static void
+FreeObjEntry(hPtr)
+    Tcl_HashEntry *hPtr;	/* Hash entry to free. */
 {
     Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
 
-    Tcl_DecrRefCount(objPtr);
-    ckfree(hPtr);
+    Tcl_DecrRefCount (objPtr);
+    ckfree ((char *) hPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclHashObjKey --
+ * HashObjKey --
  *
  *	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.
@@ -4043,55 +3266,36 @@ TclFreeObjEntry(
  *----------------------------------------------------------------------
  */
 
-unsigned int
-TclHashObjKey(
-    Tcl_HashTable *tablePtr,	/* Hash table. */
-    void *keyPtr)		/* Key from which to compute hash value. */
+static unsigned int
+HashObjKey(tablePtr, keyPtr)
+    Tcl_HashTable *tablePtr;	/* Hash table. */
+    VOID *keyPtr;		/* Key from which to compute hash value. */
 {
-    Tcl_Obj *objPtr = keyPtr;
-    int length;
-    const char *string = TclGetStringFromObj(objPtr, &length);
-    unsigned int result = 0;
+    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
+    CONST char *string = TclGetString(objPtr);
+    int length = objPtr->length;
+    unsigned int result;
+    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.
-     *
-     * Note that this function is very weak against malicious strings; it's
-     * very easy to generate multiple keys that have the same hashcode. On the
-     * other hand, that hardly ever actually occurs and this function *is*
-     * very cheap, even by comparison with industry-standard hashes like FNV.
-     * If real strength of hash is required though, use a custom hash based on
-     * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
-     * Tcl does not use that level of strength because it typically does not
-     * need it (and some of the aspects of that strength are genuinely
-     * unnecessary given the rest of Tcl's hash machinery, and the fact that
-     * we do not either transfer hashes to another machine, use them as a true
-     * substitute for equality, or attempt to minimize work in rebuilding the
-     * hash table).
-     *
-     * See also HashStringKey in tclHash.c.
-     * See also HashString in tclLiteral.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:
      *
-     * See [tcl-Feature Request #2958832]
+     * 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.
      */
 
-    if (length > 0) {
-	result = UCHAR(*string);
-	while (--length) {
-	    result += (result << 3) + UCHAR(*++string);
-	}
+    result = 0;
+    for (i=0 ; i<length ; i++) {
+	result += (result<<3) + string[i];
     }
     return result;
 }
@@ -4101,81 +3305,112 @@ TclHashObjKey(
  *
  * 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 function 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 procedure is
+ *	called with the same object, the command can be found quickly.
  *
  *----------------------------------------------------------------------
  */
 
 Tcl_Command
-Tcl_GetCommandFromObj(
-    Tcl_Interp *interp,		/* The interpreter in which to resolve the
+Tcl_GetCommandFromObj(interp, objPtr)
+    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;
+    int result;
+    CallFrame *savedFramePtr;
+    char *name;
 
     /*
-     * Get the internal representation, converting to a command type if
-     * 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 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]
      */
 
-    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
-        register Command *cmdPtr = resPtr->cmdPtr;
-
-        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
-                && !(cmdPtr->flags & CMD_IS_DELETED)
-                && (interp == cmdPtr->nsPtr->interp)
-                && !(cmdPtr->nsPtr->flags & NS_DYING)) {
-            register Namespace *refNsPtr = (Namespace *)
-                    TclGetCurrentNamespace(interp);
-
-            if ((resPtr->refNsPtr == NULL)
-                || ((refNsPtr == resPtr->refNsPtr)
-                    && (resPtr->refNsId == refNsPtr->nsId)
-                    && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
-                return (Tcl_Command) cmdPtr;
-            }
+    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.
+     */
+    
+    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;
+    }
 
     /*
-     * OK, must create a new internal representation (or fail) as any cache we
-     * had is invalid one way or another.
+     * 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 (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
-        return 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;
+        }
     }
-    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
+    iPtr->varFramePtr = savedFramePtr;
+    return (Tcl_Command) cmdPtr;
 }
 
 /*
@@ -4191,59 +3426,54 @@ Tcl_GetCommandFromObj(
  *
  * 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
- *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
+ *	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(
-    Tcl_Interp *interp,		/* Points to interpreter containing command
+TclSetCmdNameObj(interp, objPtr, cmdPtr)
+    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;
-    const char *name;
 
-    if (objPtr->typePtr == &tclCmdNameType) {
+    if (oldTypePtr == &tclCmdNameType) {
 	return;
     }
-
+    
+    /*
+     * Get the current namespace.
+     */
+    
+    if (iPtr->varFramePtr != NULL) {
+	currNsPtr = iPtr->varFramePtr->nsPtr;
+    } else {
+	currNsPtr = iPtr->globalNsPtr;
+    }
+    
     cmdPtr->refCount++;
-    resPtr = ckalloc(sizeof(ResolvedCmdName));
+    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;
-
-    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;
+    
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
     }
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
     objPtr->internalRep.twoPtrValue.ptr2 = NULL;
     objPtr->typePtr = &tclCmdNameType;
 }
@@ -4261,42 +3491,41 @@ TclSetCmdNameObj(
  *
  * 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(
-    register Tcl_Obj *objPtr)	/* CmdName object with internal
+FreeCmdNameInternalRep(objPtr)
+    register Tcl_Obj *objPtr;	/* CmdName object with internal
 				 * representation to free. */
 {
-    register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    register ResolvedCmdName *resPtr =
+	(ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
 
     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;
-
-	    TclCleanupCommandMacro(cmdPtr);
-	    ckfree(resPtr);
-	}
+	    
+            Command *cmdPtr = resPtr->cmdPtr;
+            TclCleanupCommand(cmdPtr);
+            ckfree((char *) resPtr);
+        }
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -4304,32 +3533,33 @@ FreeCmdNameInternalRep(
  *
  * 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(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
+DupCmdNameInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    register Tcl_Obj *copyPtr;	/* Object with internal rep to set. */
 {
-    register ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    register ResolvedCmdName *resPtr =
+        (ResolvedCmdName *) srcPtr->internalRep.twoPtrValue.ptr1;
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
+    copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
     if (resPtr != NULL) {
-	resPtr->refCount++;
+        resPtr->refCount++;
     }
     copyPtr->typePtr = &tclCmdNameType;
 }
@@ -4347,21 +3577,22 @@ DupCmdNameInternalRep(
  *
  * 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(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
+SetCmdNameFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
 {
     Interp *iPtr = (Interp *) interp;
-    const char *name;
+    char *name;
+    Tcl_Command cmd;
     register Command *cmdPtr;
     Namespace *currNsPtr;
     register ResolvedCmdName *resPtr;
@@ -4371,6 +3602,15 @@ SetCmdNameFromAny(
     }
 
     /*
+     * 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
@@ -4378,128 +3618,47 @@ SetCmdNameFromAny(
      * referenced from a CmdName object.
      */
 
-    name = TclGetString(objPtr);
-    cmdPtr = (Command *)
-	    Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
-
-    /*
-     * 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 (cmdPtr) {
-	cmdPtr->refCount++;
-	resPtr = objPtr->internalRep.otherValuePtr;
-	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 = ckalloc(sizeof(ResolvedCmdName));
-	    resPtr->refCount = 1;
-	    objPtr->internalRep.twoPtrValue.ptr1 = 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.
-	     */
-
+    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;
-
-	    resPtr->refNsPtr = currNsPtr;
-	    resPtr->refNsId = currNsPtr->nsId;
-	    resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+	} 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 {
-	TclFreeIntRep(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = NULL;
-	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-	objPtr->typePtr = &tclCmdNameType;
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_RepresentationCmd --
- *
- *	Implementation of the "tcl::unsupported::representation" command.
- *
- * Results:
- *	Reports the current representation (Tcl_Obj type) of its argument.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_RepresentationCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    char refcountBuffer[TCL_INTEGER_SPACE+1];
-    char objPtrBuffer[TCL_INTEGER_SPACE+3];
-    char internalRepBuffer[2*(TCL_INTEGER_SPACE+2)+2];
-#define TCLOBJ_TRUNCATE_STRINGREP 16
-    char stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP+1];
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "value");
-	return TCL_ERROR;
+	resPtr = NULL;	/* no command named "name" was found */
     }
 
     /*
-     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
-     * internal representation 0x45671234:0x98765432, string representation
-     * "1872361827361287"
+     * 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.
      */
 
-    sprintf(refcountBuffer, "%d", objv[1]->refCount);
-    sprintf(objPtrBuffer, "%p", (void *)objv[1]);
-    Tcl_AppendResult(interp, "value is a ", objv[1]->typePtr ?
-	    objv[1]->typePtr->name : "pure string", " with a refcount of ",
-	    refcountBuffer, ", object pointer at ", objPtrBuffer, NULL);
-    if (objv[1]->typePtr) {
-	sprintf(internalRepBuffer, "%p:%p",
-		(void *)objv[1]->internalRep.twoPtrValue.ptr1,
-		(void *)objv[1]->internalRep.twoPtrValue.ptr2);
-	Tcl_AppendResult(interp, ", internal representation ",
-		internalRepBuffer, NULL);
-    }
-    if (objv[1]->bytes) {
-	strncpy(stringRepBuffer, objv[1]->bytes, TCLOBJ_TRUNCATE_STRINGREP);
-	stringRepBuffer[TCLOBJ_TRUNCATE_STRINGREP] = 0;
-	Tcl_AppendResult(interp, ", string representation \"",
-		stringRepBuffer, objv[1]->length > TCLOBJ_TRUNCATE_STRINGREP ?
-		"\"..." : "\".", NULL);
-    } else {
-	Tcl_AppendResult(interp, ", no string representation.", NULL);
+    if ((objPtr->typePtr != NULL)
+	    && (objPtr->typePtr->freeIntRepProc != NULL)) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
     }
+    
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) resPtr;
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->typePtr = &tclCmdNameType;
     return TCL_OK;
 }
 
@@ -4508,7 +3667,6 @@ Tcl_RepresentationCmd(
  * mode: c
  * c-basic-offset: 4
  * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
  * End:
  */
+
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index 84a9136..4614edc 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -1,40 +1,43 @@
-/*
+/* 
  * 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"
-#if defined(_WIN32) || defined(__CYGWIN__)
-    MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
-#endif
+#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.
  */
 
-#if defined(__CYGWIN__)
-static Tcl_PanicProc *panicProc = tclWinDebugPanic;
-#else
 static Tcl_PanicProc *panicProc = NULL;
-#endif
+
+/*
+ * 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;
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_SetPanicProc --
  *
- *	Replace the default panic behavior with the specified function.
+ *	Replace the default panic behavior with the specified functiion.
  *
  * Results:
  *	None.
@@ -46,13 +49,9 @@ static Tcl_PanicProc *panicProc = NULL;
  */
 
 void
-Tcl_SetPanicProc(
-    Tcl_PanicProc *proc)
+Tcl_SetPanicProc(proc)
+    Tcl_PanicProc *proc;
 {
-#if defined(_WIN32)
-    /* tclWinDebugPanic only installs if there is no panicProc yet. */
-    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
-#endif
     panicProc = proc;
 }
 
@@ -73,14 +72,14 @@ Tcl_SetPanicProc(
  */
 
 void
-Tcl_PanicVA(
-    const char *format,		/* Format string, suitable for passing to
+Tcl_PanicVA (format, argList)
+    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;	/* Additional arguments (variable in number)
-				 * to pass to fprintf. */
-    char *arg4, *arg5, *arg6, *arg7, *arg8;
+    char *arg1, *arg2, *arg3, *arg4;	/* Additional arguments (variable in
+					 * number) to pass to fprintf. */
+    char *arg5, *arg6, *arg7, *arg8;
 
     arg1 = va_arg(argList, char *);
     arg2 = va_arg(argList, char *);
@@ -90,36 +89,20 @@ Tcl_PanicVA(
     arg6 = va_arg(argList, char *);
     arg7 = va_arg(argList, char *);
     arg8 = va_arg(argList, char *);
-
+    
     if (panicProc != NULL) {
-	panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
-#ifdef _WIN32
-    } else if (IsDebuggerPresent()) {
-	tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
-#endif
+	(void) (*panicProc)(format, arg1, arg2, arg3, arg4,
+		arg5, arg6, arg7, arg8);
+    } else if (platformPanicProc != NULL) {
+	(void) (*platformPanicProc)(format, arg1, arg2, arg3, arg4,
+		arg5, arg6, arg7, arg8);
     } else {
-	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
-		arg8);
-	fprintf(stderr, "\n");
-	fflush(stderr);
+	(void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
+		arg7, arg8);
+	(void) fprintf(stderr, "\n");
+	(void) fflush(stderr);
+	abort();
     }
-    /* In case the users panic proc does not abort, we do it here */
-#if defined(_WIN32) || defined(__CYGWIN__)
-#   if defined(__GNUC__)
-    __builtin_trap();
-#   elif defined(_WIN64)
-    __debugbreak();
-#   elif defined(_MSC_VER)
-    _asm {int 3}
-#   else
-    DebugBreak();
-#   endif
-#endif
-#if defined(_WIN32)
-    ExitProcess(1);
-#else
-    abort();
-#endif
 }
 
 /*
@@ -138,23 +121,14 @@ Tcl_PanicVA(
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
+	/* VARARGS ARGSUSED */
 void
-Tcl_Panic(
-    const char *format,
-    ...)
+Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
 {
     va_list argList;
+    CONST char *format;
 
-    va_start(argList, format);
+    format = TCL_VARARGS_START(CONST char *,arg1,argList);
     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 f0050c6..a3f8433 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1,48 +1,61 @@
-/*
+/* 
  * tclParse.c --
  *
- *	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.
+ *	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.  
  *
  * 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 "tclParse.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).
  */
 
-const char charTypeTable[] = {
+#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[] = {
     /*
      * Negative character values, from -128 to -1:
      */
@@ -156,120 +169,96 @@ const char charTypeTable[] = {
 };
 
 /*
- * Prototypes for local functions defined in this file:
+ * Prototypes for local procedures defined in this file:
  */
 
-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.
- *
- *----------------------------------------------------------------------
- */
+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));
 
-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 function parses the first Tcl command in the
- *	string and returns information about the structure of the command.
+ *	Given a string, this procedure 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 function
- *	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 procedure returns TCL_OK then the caller must
+ *	eventually invoke Tcl_FreeParse to release any additional space
+ *	that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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
+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
 				 * 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 ((start == NULL) && (numBytes != 0)) {
+    
+    if ((string == 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(start);
+	numBytes = strlen(string);
     }
-    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 {
@@ -281,9 +270,8 @@ Tcl_ParseCommand(
      * command.
      */
 
-    scanned = ParseComment(start, numBytes, parsePtr);
-    src = (start + scanned);
-    numBytes -= scanned;
+    scanned = ParseComment(string, numBytes, parsePtr);
+    src = (string + scanned); numBytes -= scanned;
     if (numBytes == 0) {
 	if (nested) {
 	    parsePtr->incomplete = nested;
@@ -291,19 +279,19 @@ Tcl_ParseCommand(
     }
 
     /*
-     * 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.
 	 */
 
-	TclGrowParseTokenArray(parsePtr, 1);
+	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+	    TclExpandTokenArray(parsePtr);
+	}
 	wordIndex = parsePtr->numTokens;
 	tokenPtr = &parsePtr->tokenPtr[wordIndex];
 	tokenPtr->type = TCL_TOKEN_WORD;
@@ -313,9 +301,8 @@ Tcl_ParseCommand(
 	 * sequence: it should be treated just like white space.
 	 */
 
-	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
-	src += scanned;
-	numBytes -= scanned;
+	scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+	src += scanned; numBytes -= scanned;
 	if (numBytes == 0) {
 	    parsePtr->term = src;
 	    break;
@@ -330,230 +317,60 @@ Tcl_ParseCommand(
 	parsePtr->numWords++;
 
 	/*
-	 * 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).
+	 * 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).
 	 */
 
-    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 == '{') {
-	    int expIdx = wordIndex + 1;
-	    Tcl_Token *expPtr;
-
-	    if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1,
-		    &termPtr) != TCL_OK) {
+	    if (Tcl_ParseBraces(interp, src, numBytes,
+		    parsePtr, 1, &termPtr) != TCL_OK) {
 		goto error;
 	    }
-	    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;
-	    }
+	    src = termPtr; numBytes = parsePtr->end - src;
 	} 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,
-		    TCL_SUBST_ALL, parsePtr) != TCL_OK) {
+		    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 (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)
+	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 = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
+	scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
 	if (scanned) {
-	    src += scanned;
-	    numBytes -= scanned;
+	    src += scanned; numBytes -= scanned;
 	    continue;
 	}
 
@@ -563,10 +380,10 @@ Tcl_ParseCommand(
 	}
 	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);
@@ -586,72 +403,51 @@ Tcl_ParseCommand(
     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;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclIsSpaceProc --
- *
- *	Report whether byte is in the set of whitespace characters used by
- *	Tcl to separate words in scripts or elements in lists.
- *
- * Results:
- *	Returns 1, if byte is in the set, 0 otherwise.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
 
-int
-TclIsSpaceProc(
-    char byte)
-{
-    return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
-}
-
 /*
  *----------------------------------------------------------------------
  *
- * ParseWhiteSpace --
+ * TclParseWhiteSpace --
  *
- *	Scans up to numBytes bytes starting at src, consuming white space
- *	between words as defined by Tcl's parsing rules.
+ *	Scans up to numBytes bytes starting at src, consuming white
+ *	space 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.
+ *	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 */
+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 */
 {
     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 != '\\') {
@@ -663,9 +459,9 @@ ParseWhiteSpace(
 	    if (p[1] != '\n') {
 		break;
 	    }
-	    p += 2;
+	    p+=2;
 	    if (--numBytes == 0) {
-		*incompletePtr = 1;
+		parsePtr->incomplete = 1;
 		break;
 	    }
 	    continue;
@@ -679,76 +475,44 @@ ParseWhiteSpace(
 /*
  *----------------------------------------------------------------------
  *
- * 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(
-    const char *src,		/* First character to parse. */
-    int numBytes,		/* Max number of byes to scan */
-    int *resultPtr)	/* Points to storage provided by caller where
-				 * the character resulting from the
-				 * conversion is to be written. */
+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. */
 {
-    int result = 0;
-    register const char *p = src;
+    Tcl_UniChar result = 0;
+    register CONST char *p = src;
 
     while (numBytes--) {
 	unsigned char digit = UCHAR(*p);
 
-	if (!isxdigit(digit) || (result > 0x10fff)) {
+	if (!isxdigit(digit))
 	    break;
-	}
 
-	p++;
+	++p;
 	result <<= 4;
 
 	if (digit >= 'a') {
@@ -769,37 +533,36 @@ TclParseHex(
  *
  * 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.
+ * 	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.
  *
  * Side effects:
- *	None.
+ * 	None.
  *
  *----------------------------------------------------------------------
  */
-
 int
-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. */
+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. */
 {
-    register const char *p = src+1;
-    Tcl_UniChar unichar;
-    int result;
+    register CONST char *p = src+1;
+    Tcl_UniChar result;
     int count;
     char buf[TCL_UTF_MAX];
 
@@ -811,14 +574,11 @@ TclParseBackslash(
     }
 
     if (dst == NULL) {
-	dst = buf;
+        dst = buf;
     }
 
     if (numBytes == 1) {
-	/*
-	 * Can only scan the backslash, so return it.
-	 */
-
+	/* Can only scan the backslash.  Return it. */
 	result = '\\';
 	count = 1;
 	goto done;
@@ -826,129 +586,107 @@ TclParseBackslash(
 
     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 > 3) ? 2 : 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 'U':
-	count += TclParseHex(p+1, (numBytes > 9) ? 8 : 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 = *p - '0';
-	    p++;
-	    if ((numBytes == 2) || !isdigit(UCHAR(*p))	/* INTL: digit */
-		    || (UCHAR(*p) >= '8')) {
-		break;
+        /*
+         * 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;
 	    }
-	    count = 3;
-	    result = (result << 3) + (*p - '0');
-	    p++;
-	    if ((numBytes == 3) || !isdigit(UCHAR(*p))	/* INTL: digit */
-		    || (UCHAR(*p) >= '8') || (result >= 0x20)) {
-		break;
+            break;
+        case 'u':
+	    count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
+	    if (count == 2) {
+		/* No hexadigits -> This is just "u". */
+		result = 'u';
 	    }
-	    count = 4;
-	    result = UCHAR((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, &unichar) + 1;	/* +1 for '\' */
-	} else {
-	    char utfBytes[TCL_UTF_MAX];
-
-	    memcpy(utfBytes, p, (size_t) (numBytes - 1));
-	    utfBytes[numBytes - 1] = '\0';
-	    count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
-	}
-	result = unichar;
-	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;
+	    }
+            break;
     }
 
-  done:
+    done:
     if (readPtr != NULL) {
-	*readPtr = count;
+        *readPtr = count;
     }
-    return Tcl_UniCharToUtf(result, dst);
+    return Tcl_UniCharToUtf((int) result, dst);
 }
 
 /*
@@ -956,69 +694,57 @@ TclParseBackslash(
  *
  * 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.
+ * 	None.
  *
  *----------------------------------------------------------------------
  */
-
 static int
-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. */
+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. */
 {
-    register const char *p = src;
-
+    register CONST char *p = src;
     while (numBytes) {
 	char type;
 	int scanned;
-
 	do {
-	    scanned = ParseWhiteSpace(p, numBytes,
-		    &parsePtr->incomplete, &type);
-	    p += scanned;
-	    numBytes -= scanned;
+	    scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &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 = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete,
-			&type);
+		scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &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;
 		}
@@ -1028,25 +754,27 @@ ParseComment(
     }
     return (p - src);
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * ParseTokens --
  *
- *	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.
+ *	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.
  *
  * 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 is
- *	not 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 isn't NULL, then an error
+ *	message is left in the interpreter's result.
  *
  * Side effects:
  *	None.
@@ -1055,49 +783,45 @@ ParseComment(
  */
 
 static int
-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.
+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.
 				 * Updated with additional tokens and
 				 * termination information. */
 {
-    char type;
-    int originalTokens;
-    int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
-    int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
-    int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
+    char type; 
+    int originalTokens, varToken;
     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)) {
-	TclGrowParseTokenArray(parsePtr, 1);
+	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+	    TclExpandTokenArray(parsePtr);
+	}
 	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 */
 	    }
@@ -1105,115 +829,81 @@ ParseTokens(
 	    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--;
-	    nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
+	    src++; numBytes--;
 	    while (1) {
-		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);
+		if (Tcl_ParseCommand(parsePtr->interp, src,
+			numBytes, 1, &nested) != TCL_OK) {
+		    parsePtr->errorType = nested.errorType;
+		    parsePtr->term = nested.term;
+		    parsePtr->incomplete = nested.incomplete;
 		    return TCL_ERROR;
 		}
-		src = nestedPtr->commandStart + nestedPtr->commandSize;
+		src = nested.commandStart + nested.commandSize;
 		numBytes = parsePtr->end - src;
-		Tcl_FreeParse(nestedPtr);
+
+		/*
+		 * 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.
+		 * substitution.  It must have been the last character of
+		 * the parsed command.
 		 */
 
-		if ((nestedPtr->term < parsePtr->end)
-			&& (*(nestedPtr->term) == ']')
-			&& !(nestedPtr->incomplete)) {
+		if ((nested.term < parsePtr->end) && (*nested.term == ']')
+			&& !nested.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;
 	    }
 
@@ -1223,9 +913,9 @@ ParseTokens(
 		}
 
 		/*
-		 * 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) {
@@ -1244,24 +934,25 @@ ParseTokens(
 	    tokenPtr->type = TCL_TOKEN_TEXT;
 	    tokenPtr->size = 1;
 	    parsePtr->numTokens++;
-	    src++;
-	    numBytes--;
+	    src++; numBytes--;
 	} else {
-	    Tcl_Panic("ParseTokens encountered unknown character");
+	    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.
 	 */
-
-	TclGrowParseTokenArray(parsePtr, 1);
+	if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+	    TclExpandTokenArray(parsePtr);
+	}
 	tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
 	tokenPtr->start = src;
 	tokenPtr->numComponents = 0;
 
-    finishToken:
+	finishToken:
 	tokenPtr->type = TCL_TOKEN_TEXT;
 	tokenPtr->size = 0;
 	parsePtr->numTokens++;
@@ -1269,112 +960,171 @@ ParseTokens(
     parsePtr->term = src;
     return TCL_OK;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_FreeParse --
  *
- *	This function is invoked to free any dynamic storage that may have
- *	been allocated by a previous call to Tcl_ParseCommand.
+ *	This procedure 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(
-    Tcl_Parse *parsePtr)	/* Structure that was filled in by a previous
-				 * call to Tcl_ParseCommand. */
+Tcl_FreeParse(parsePtr)
+    Tcl_Parse *parsePtr;	/* Structure that was filled in by a
+				 * previous call to Tcl_ParseCommand. */
 {
     if (parsePtr->tokenPtr != parsePtr->staticTokens) {
-	ckfree(parsePtr->tokenPtr);
+	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 function
- *	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 procedure returns TCL_OK then the caller must
+ *	eventually invoke Tcl_FreeParse to release any additional space
+ *	that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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,
+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,
 				 * 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) || (start == NULL)) {
+    if ((numBytes == 0) || (string == NULL)) {
 	return TCL_ERROR;
     }
     if (numBytes < 0) {
-	numBytes = strlen(start);
+	numBytes = strlen(string);
     }
 
     if (!append) {
-	TclParseInit(interp, start, numBytes, parsePtr);
+	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;
     }
 
     /*
-     * 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 = start;
-    TclGrowParseTokenArray(parsePtr, 2);
+    src = string;
+    if ((parsePtr->numTokens + 2) > parsePtr->tokensAvailable) {
+	TclExpandTokenArray(parsePtr);
+    }
     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;
     }
@@ -1384,30 +1134,29 @@ Tcl_ParseVarName(
 
     /*
      * 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) {
@@ -1427,29 +1176,24 @@ Tcl_ParseVarName(
 	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;
 	    }
@@ -1459,7 +1203,6 @@ Tcl_ParseVarName(
 	/*
 	 * Support for empty array names here.
 	 */
-
 	array = (numBytes && (*src == '('));
 	tokenPtr->size = src - tokenPtr->start;
 	if ((tokenPtr->size == 0) && !array) {
@@ -1468,16 +1211,17 @@ Tcl_ParseVarName(
 	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 (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
-		    TCL_SUBST_ALL, parsePtr)) {
+	    if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
+		    != TCL_OK) {
 		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);
@@ -1496,37 +1240,38 @@ Tcl_ParseVarName(
     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.
@@ -1534,53 +1279,50 @@ Tcl_ParseVarName(
  *----------------------------------------------------------------------
  */
 
-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. */
+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. */
+
 {
+    Tcl_Parse parse;
     register Tcl_Obj *objPtr;
     int code;
-    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
 
-    if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
-	TclStackFree(interp, parsePtr);
+    if (Tcl_ParseVarName(interp, string, -1, &parse, 0) != TCL_OK) {
 	return NULL;
     }
 
     if (termPtr != NULL) {
-	*termPtr = start + parsePtr->tokenPtr->size;
+	*termPtr = string + parse.tokenPtr->size;
     }
-    if (parsePtr->numTokens == 1) {
+    if (parse.numTokens == 1) {
 	/*
 	 * There isn't a variable name after all: the $ is just a $.
 	 */
 
-	TclStackFree(interp, parsePtr);
 	return "$";
     }
 
-    code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
-	    NULL, 1, NULL, NULL);
-    TclStackFree(interp, parsePtr);
+    code = Tcl_EvalTokensStandard(interp, parse.tokenPtr, parse.numTokens);
     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)) {
@@ -1589,75 +1331,87 @@ Tcl_ParseVar(
     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 function parses the string and returns
- *	information about the parse. No more than numBytes bytes will be
- *	scanned.
+ *	value in a Tcl expression, this procedure 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 function
- *	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 procedure returns TCL_OK then the caller must
+ *	eventually invoke Tcl_FreeParse to release any additional space
+ *	that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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
+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
 				 * 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) || (start == NULL)) {
+    if ((numBytes == 0) || (string == NULL)) {
 	return TCL_ERROR;
     }
     if (numBytes < 0) {
-	numBytes = strlen(start);
+	numBytes = strlen(string);
     }
 
     if (!append) {
-	TclParseInit(interp, start, numBytes, parsePtr);
+	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;
     }
 
-    src = start;
+    src = string;
     startIndex = parsePtr->numTokens;
 
-    TclGrowParseTokenArray(parsePtr, 1);
+    if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+	TclExpandTokenArray(parsePtr);
+    }
     tokenPtr = &parsePtr->tokenPtr[startIndex];
     tokenPtr->type = TCL_TOKEN_TEXT;
     tokenPtr->start = src+1;
@@ -1670,189 +1424,195 @@ Tcl_ParseBraces(
 	    }
 	}
 	if (numBytes == 0) {
-	    goto missingBraceError;
-	}
+	    register int openBrace = 0;
 
-	switch (*src) {
-	case '{':
-	    level++;
-	    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;
-	    }
-	    break;
-	case '\\':
-	    TclParseBackslash(src, numBytes, &length, NULL);
-	    if ((length > 1) && (src[1] == '\n')) {
+	    parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
+	    parsePtr->term = string;
+	    parsePtr->incomplete = 1;
+	    if (parsePtr->interp == NULL) {
 		/*
-		 * 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.
+		 * Skip straight to the exit code since we have no
+		 * interpreter to put error message in.
 		 */
-
-		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;
+		goto error;
 	    }
-	    break;
-	}
-    }
-
-  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);
+	    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.
-     */
+	    /*
+	     *  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 > 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;
+		}
+	    }
 
-	while (--src > start) {
-	    switch (*src) {
+	    error:
+	    Tcl_FreeParse(parsePtr);
+	    return TCL_ERROR;
+	}
+	switch (*src) {
 	    case '{':
-		openBrace = 1;
+		level++;
 		break;
-	    case '\n':
-		openBrace = 0;
+	    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;
+		}
 		break;
-	    case '#' :
-		if (openBrace && TclIsSpaceProc(src[-1])) {
-		    Tcl_AppendResult(parsePtr->interp,
-			    ": possible unbalanced brace in comment", NULL);
-		    goto error;
+	    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;
 		}
 		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 function 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 procedure 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 function
- *	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 procedure returns TCL_OK then the caller must
+ *	eventually invoke Tcl_FreeParse to release any additional space
+ *	that was allocated.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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
+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
 				 * 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) || (start == NULL)) {
+    if ((numBytes == 0) || (string == NULL)) {
 	return TCL_ERROR;
     }
     if (numBytes < 0) {
-	numBytes = strlen(start);
+	numBytes = strlen(string);
     }
 
     if (!append) {
-	TclParseInit(interp, start, numBytes, parsePtr);
+	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;
     }
-
-    if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL,
-	    parsePtr)) {
+    
+    if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
 	goto error;
     }
     if (*parsePtr->term != '"') {
@@ -1860,7 +1620,7 @@ Tcl_ParseQuotedString(
 	    Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
 	}
 	parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
-	parsePtr->term = start;
+	parsePtr->term = string;
 	parsePtr->incomplete = 1;
 	goto error;
     }
@@ -1869,541 +1629,24 @@ Tcl_ParseQuotedString(
     }
     return TCL_OK;
 
-  error:
+    error:
     Tcl_FreeParse(parsePtr);
     return TCL_ERROR;
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSubstParse --
- *
- *	Token parser used by the [subst] command. Parses the string made up of
- *	'numBytes' bytes starting at 'bytes'. Parsing is controlled by the
- *	flags argument to provide support for the -nobackslashes, -nocommands,
- *	and -novariables options, as represented by the flag values
- *	TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES.
- *	
- * Results:
- *	None.
- *
- * Side effects:
- *	The Tcl_Parse struct '*parsePtr' is filled with parse results.
- *	The caller is expected to eventually call Tcl_FreeParse() to properly
- *	cleanup the value written there.
- *
- *	If a parse error occurs, the Tcl_InterpState value '*statePtr' is
- *	filled with the state created by that error. When *statePtr is written
- *	to, the caller is expected to make the required calls to either
- *	Tcl_RestoreInterpState() or Tcl_DiscardInterpState() to dispose of the
- *	value written there.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSubstParse(
-    Tcl_Interp *interp,
-    const char *bytes,
-    int numBytes,
-    int flags,
-    Tcl_Parse *parsePtr,
-    Tcl_InterpState *statePtr)
-{
-    int length = numBytes;
-    const char *p = bytes;
-
-    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 interpreter state for possible
-	 * error reporting later.
-	 */
-
-	*statePtr = Tcl_SaveInterpState(interp, TCL_ERROR);
-
-	/*
-	 * 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("TclSubstParse: programming error");
-		}
-		if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
-		    Tcl_Panic("TclSubstParse: 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 =
-			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 TclSubstParse: %c", p[length]);
-	}
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 or
-				 * 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 = 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 = ckrealloc(clPosition,
-				maxNumCL * sizeof(int));
-		    }
-		    clPosition[numCL] = clPos;
-		    numCL++;
-		}
-		adjust++;
-	    }
-	    break;
-
-	case TCL_TOKEN_COMMAND: {
-	    /* TIP #280: Transfer line information to nested command */
-	    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;
-		code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
-			0, theline, clNextOuter, outerScript);
-
-		TclAdvanceLines(&line, tokenPtr->start+1,
-			tokenPtr->start + tokenPtr->size - 1);
-
-		/*
-		 * Restore flag reset by nested eval for future bracketed
-		 * commands and their cmdframe setup
-		 */
-
-		if (inFile) {
-		    iPtr->evalFlags |= TCL_EVAL_FILE;
-		}
-	    }
-	    iPtr->numLevels--;
-	    TclResetCancellation(interp, 0);
-	    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(clPosition);
-	    }
-	} else {
-	    Tcl_ResetResult(interp);
-	}
-    }
-    if (tokensLeftPtr != NULL) {
-	*tokensLeftPtr = count;
-    }
-    if (result != NULL) {
-	Tcl_DecrRefCount(result);
-    }
-    return code;
-}
-
 /*
  *----------------------------------------------------------------------
  *
  * CommandComplete --
  *
- *	This function is shared by TclCommandComplete and
- *	Tcl_ObjCommandComplete; it does all the real work of seeing whether a
- *	script is complete
+ *	This procedure is shared by TclCommandComplete and
+ *	Tcl_ObjCommandcoComplete; 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.
@@ -2411,18 +1654,19 @@ TclSubstTokens(
  *----------------------------------------------------------------------
  */
 
-static inline int
-CommandComplete(
-    const char *script,		/* Script to check. */
-    int numBytes)		/* Number of bytes in script. */
+static int
+CommandComplete(script, numBytes)
+    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(NULL, p, end - p, 0, &parse) == TCL_OK) {
+    while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
+	    == TCL_OK) {
 	p = parse.commandStart + parse.commandSize;
 	if (p >= end) {
 	    break;
@@ -2437,20 +1681,20 @@ CommandComplete(
     Tcl_FreeParse(&parse);
     return result;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_CommandComplete --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -2459,20 +1703,20 @@ CommandComplete(
  */
 
 int
-Tcl_CommandComplete(
-    const char *script)		/* Script to check. */
+Tcl_CommandComplete(script)
+    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 function
- *	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
+ *	procedure 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.
@@ -2484,23 +1728,24 @@ Tcl_CommandComplete(
  */
 
 int
-TclObjCommandComplete(
-    Tcl_Obj *objPtr)		/* Points to object holding script to
-				 * check. */
+TclObjCommandComplete(objPtr)
+    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.
@@ -2512,42 +1757,34 @@ TclObjCommandComplete(
  */
 
 int
-TclIsLocalScalar(
-    const char *src,
-    int len)
+TclIsLocalScalar(src, len)
+    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++) {
-	if ((CHAR_TYPE(*p) != TYPE_NORMAL)
-		&& (CHAR_TYPE(*p) != TYPE_COMMAND_END)) {
+    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/tclParse.h b/generic/tclParse.h
deleted file mode 100644
index be1ab15..0000000
--- a/generic/tclParse.h
+++ /dev/null
@@ -1,17 +0,0 @@
-/*
- * Minimal set of shared macro definitions and declarations so that multiple
- * source files can make use of the parsing table in tclParse.c
- */
-
-#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)]
-
-MODULE_SCOPE const char charTypeTable[];
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
new file mode 100644
index 0000000..e07b7e7
--- /dev/null
+++ b/generic/tclParseExpr.c
@@ -0,0 +1,2083 @@
+/* 
+ * 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
deleted file mode 100644
index 4f86755..0000000
--- a/generic/tclPathObj.c
+++ /dev/null
@@ -1,2739 +0,0 @@
-/*
- * 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);
-
-/*
- * Define the 'path' object type, which Tcl uses to represent file paths
- * internally.
- */
-
-static const 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. */
-    struct FilesystemRecord *fsRecPtr;
-				/* Pointer to the filesystem record entry to
-				 * use for 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.otherValuePtr)
-#define SETPATHOBJ(pathPtr,fsPathPtr) \
-	((pathPtr)->internalRep.otherValuePtr = (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 */
-    ClientData *clientDataPtr)	/* If non-NULL, then may be set to the
-				 * fs-specific clientData for this path. This
-				 * will happen when that extra information can
-				 * be calculated efficiently as a side-effect
-				 * of normalization. */
-{
-    ClientData clientData = NULL;
-    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);
-		}
-		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 *linkObj;
-		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);
-		}
-		Tcl_GetStringFromObj(retVal, &curLen);
-		if (curLen == 0) {
-		    Tcl_AppendToObj(retVal, dirSep, 1);
-		}
-		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
-		    linkObj = 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 (linkObj != 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(linkObj)
-					== 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, linkObj);
-			    TclDecrRefCount(linkObj);
-			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
-			} else {
-			    /*
-			     * Absolute link.
-			     */
-
-			    TclDecrRefCount(retVal);
-			    if (Tcl_IsShared(linkObj)) {
-				retVal = Tcl_DuplicateObj(linkObj);
-				TclDecrRefCount(linkObj);
-			    } else {
-				retVal = linkObj;
-			    }
-			    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, &clientData);
-
-    /*
-     * Since we know it is a normalized path, we can actually convert this
-     * object into an FsPath for greater efficiency
-     */
-
-    TclFSMakePathFromNormalized(interp, retVal, clientData);
-    if (clientDataPtr != NULL) {
-	*clientDataPtr = clientData;
-    }
-
-    /*
-     * 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,
-    const 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 (TclFSEpochOk(fsPathPtr->filesystemEpoch)
-		&& (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 *copy, *res;
-    int objc;
-    Tcl_Obj **objv;
-
-    if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) {
-	return NULL;
-    }
-
-    elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
-    copy = TclListObjCopy(NULL, listObj);
-    Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
-    res = TclJoinPath(elements, objv);
-    Tcl_DecrRefCount(copy);
-    return res;
-}
-
-Tcl_Obj *
-TclJoinPath(
-    int elements,
-    Tcl_Obj * const objv[])
-{
-    Tcl_Obj *res;
-    int i;
-    const Tcl_Filesystem *fsPtr = NULL;
-
-    res = NULL;
-
-    for (i = 0; i < elements; i++) {
-	int driveNameLength, strEltLen, length;
-	Tcl_PathType type;
-	char *strElt, *ptr;
-	Tcl_Obj *driveName = NULL;
-	Tcl_Obj *elt = objv[i];
-
-	/*
-	 * 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 *tailObj = objv[i+1];
-
-	    type = TclGetPathType(tailObj, NULL, NULL, NULL);
-	    if (type == TCL_PATH_RELATIVE) {
-		const char *str;
-		int len;
-
-		str = Tcl_GetStringFromObj(tailObj, &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 tailObj;
-	    } else {
-		const char *str = TclGetString(tailObj);
-
-		if (tclPlatform == TCL_PLATFORM_WINDOWS) {
-		    if (strchr(str, '\\') == NULL) {
-			if (res != NULL) {
-			    TclDecrRefCount(res);
-			}
-			return tailObj;
-		    }
-		}
-	    }
-	}
-	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);
-		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;
-    ThreadSpecificData *tsdPtr;
-    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;
-    }
-
-    tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
-    pathPtr = Tcl_NewObj();
-    fsPathPtr = 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->fsRecPtr = NULL;
-    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-    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 TclJoinPath() 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) {
-	    return fsPathPtr->normPathPtr;
-	}
-    }
-
-    /*
-     * 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);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *pathPtr,		/* The object to convert. */
-    ClientData nativeRep)	/* The native rep for the object, if known
-				 * else NULL. */
-{
-    FsPath *fsPathPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
-    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);
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
-			    NULL);
-		}
-		return TCL_ERROR;
-	    }
-	    pathPtr->typePtr->updateStringProc(pathPtr);
-	}
-	TclFreeIntRep(pathPtr);
-    }
-
-    fsPathPtr = 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 = nativeRep;
-    fsPathPtr->fsRecPtr = NULL;
-    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-    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(
-    const Tcl_Filesystem *fromFilesystem,
-    ClientData clientData)
-{
-    Tcl_Obj *pathPtr;
-    FsPath *fsPathPtr;
-
-    FilesystemRecord *fsFromPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
-    pathPtr = TclFSInternalToNormalized(fromFilesystem, clientData,
-	    &fsFromPtr);
-    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 = ckalloc(sizeof(FsPath));
-
-    fsPathPtr->translatedPathPtr = NULL;
-
-    /*
-     * Circular reference, by design.
-     */
-
-    fsPathPtr->normPathPtr = pathPtr;
-    fsPathPtr->cwdPtr = NULL;
-    fsPathPtr->nativePathPtr = clientData;
-    fsPathPtr->fsRecPtr = fsFromPtr;
-    fsPathPtr->fsRecPtr->fileRefCount++;
-    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
-
-    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;
-	    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 = ckalloc(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 cwdLen, pathType;
-	ClientData clientData = NULL;
-
-	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);
-	}
-
-	copy = AppendPath(dir, fsPathPtr->normPathPtr);
-	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, NULL);
-
-	    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,
-		    (fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
-	}
-
-	/* 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);
-	}
-	if (clientData != NULL) {
-	    /*
-	     * This may be unnecessary. It appears that the
-	     * TclFSNormalizeToUniquePath call above should have already set
-	     * this up. Not changing out of fear of the unknown.
-	     */
-
-	    fsPathPtr->nativePathPtr = clientData;
-	}
-	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;
-	    ClientData clientData = NULL;
-
-	    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->nativePathPtr == NULL ? &clientData : NULL));
-	    fsPathPtr->normPathPtr = copy;
-	    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
-	    if (clientData != NULL) {
-		fsPathPtr->nativePathPtr = clientData;
-	    }
-	}
-    }
-    if (fsPathPtr->normPathPtr == NULL) {
-	ClientData clientData = 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,
-		(fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
-	if (0 && (clientData != NULL)) {
-	    fsPathPtr->nativePathPtr =
-		   fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc(clientData);
-	}
-
-	/*
-	 * Check if path is pure normalized (this can only be the case if it
-	 * is an absolute path).
-	 */
-
-	if (pureNormalized) {
-	    int normPathLen, pathLen;
-	    const char *normPath;
-
-	    path = TclGetStringFromObj(pathPtr, &pathLen);
-	    normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
-	    if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
-		/*
-		 * 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,
-    const 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->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(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->fsRecPtr == 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->fsRecPtr->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->fsRecPtr->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,
-    const 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->fsRecPtr != NULL) {
-	*fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
-    }
-    return TCL_OK;
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * TclFSSetPathDetails --
- *
- *	???
- *
- * Results:
- *	None
- *
- * Side effects:
- *	???
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclFSSetPathDetails(
-    Tcl_Obj *pathPtr,
-    FilesystemRecord *fsRecPtr,
-    ClientData clientData)
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-    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->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(
-    Tcl_Obj *firstPtr,
-    Tcl_Obj *secondPtr)
-{
-    const char *firstStr, *secondStr;
-    int firstLen, secondLen, tempErrno;
-
-    if (firstPtr == secondPtr) {
-	return 1;
-    }
-
-    if (firstPtr == NULL || secondPtr == NULL) {
-	return 0;
-    }
-    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
-    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
-    if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
-	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 = TclGetStringFromObj(firstPtr, &firstLen);
-    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
-    return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * 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;
-     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
-
-    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] == '~') {
-	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);
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
-			    "HOMELESS", 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_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
-			    NULL);
-		}
-		Tcl_DStringFree(&temp);
-		if (split != len) {
-		    name[split] = separator;
-		}
-		return TCL_ERROR;
-	    }
-	    if (split != len) {
-		name[split] = separator;
-	    }
-	}
-
-	transPtr = TclDStringToObj(&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;
-	    }
-	}
-    } else {
-	transPtr = TclJoinPath(1, &pathPtr);
-    }
-
-    /*
-     * Now we have a translated filename in 'transPtr'. This will have forward
-     * slashes on Windows, and will not contain any ~user sequences.
-     */
-
-    fsPathPtr = ckalloc(sizeof(FsPath));
-
-    fsPathPtr->translatedPathPtr = transPtr;
-    if (transPtr != pathPtr) {
-	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.
-     */
-
-    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->fsRecPtr != NULL) {
-	Tcl_FSFreeInternalRepProc *freeProc =
-		fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc;
-
-	if (freeProc != NULL) {
-	    freeProc(fsPathPtr->nativePathPtr);
-	    fsPathPtr->nativePathPtr = NULL;
-	}
-    }
-    if (fsPathPtr->fsRecPtr != NULL) {
-	fsPathPtr->fsRecPtr->fileRefCount--;
-	if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
-	    /*
-	     * It has been unregistered already.
-	     */
-
-	    ckfree(fsPathPtr->fsRecPtr);
-	}
-    }
-
-    ckfree(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 = 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->fsRecPtr != NULL
-	    && srcFsPathPtr->nativePathPtr != NULL) {
-	Tcl_FSDupInternalRepProc *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(
-    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 d0b136d..6e7029e 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -1,56 +1,60 @@
-/*
+/* 
  * 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 functions defined in this file:
+ * Declarations for local procedures defined in this file:
  */
 
-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);
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * FileForRedirect --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -59,33 +63,34 @@ static TclFile		FileForRedirect(Tcl_Interp *interp, const char *spec,
  */
 
 static TclFile
-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
+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 
 				 * 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;
@@ -94,37 +99,30 @@ FileForRedirect(
 	    }
 	    *skipPtr = 2;
 	}
-	chan = Tcl_GetChannel(interp, spec, NULL);
-	if (chan == (Tcl_Channel) NULL) {
-	    return NULL;
-	}
+        chan = Tcl_GetChannel(interp, spec, NULL);
+        if (chan == (Tcl_Channel) NULL) {
+            return NULL;
+        }
 	file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
-	if (file == 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);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
-			"BADCHAN", NULL);
-	    }
-	    return NULL;
-	}
+        if (file == NULL) {
+	    Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
+		    "\" wasn't opened for ",
+		    ((writing) ? "writing" : "reading"), (char *) 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);
+            Tcl_Flush(chan);
 	}
     } else {
-	const char *name;
+	CONST char *name;
 	Tcl_DString nameString;
 
 	if (*spec == '\0') {
@@ -143,17 +141,16 @@ FileForRedirect(
 	if (file == NULL) {
 	    Tcl_AppendResult(interp, "couldn't ",
 		    ((writing) ? "write" : "read"), " file \"", spec, "\": ",
-		    Tcl_PosixError(interp), NULL);
+		    Tcl_PosixError(interp), (char *) NULL);
 	    return NULL;
 	}
-	*closePtr = 1;
+        *closePtr = 1;
     }
     return file;
 
-  badLastArg:
+    badLastArg:
     Tcl_AppendResult(interp, "can't specify \"", arg,
-	    "\" as last word in command", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
+	    "\" as last word in command", (char *) NULL);
     return NULL;
 }
 
@@ -162,9 +159,10 @@ FileForRedirect(
  *
  * Tcl_DetachPids --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -176,17 +174,17 @@ FileForRedirect(
  */
 
 void
-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. */
+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. */
 {
     register Detached *detPtr;
     int i;
 
     Tcl_MutexLock(&pipeMutex);
     for (i = 0; i < numPids; i++) {
-	detPtr = ckalloc(sizeof(Detached));
+	detPtr = (Detached *) ckalloc(sizeof(Detached));
 	detPtr->pid = pidPtr[i];
 	detPtr->nextPtr = detList;
 	detList = detPtr;
@@ -200,22 +198,23 @@ Tcl_DetachPids(
  *
  * Tcl_ReapDetachedProcs --
  *
- *	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.
+ *	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.
  *
  * 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(void)
+Tcl_ReapDetachedProcs()
 {
     register Detached *detPtr;
     Detached *nextPtr, *prevPtr;
@@ -236,7 +235,7 @@ Tcl_ReapDetachedProcs(void)
 	} else {
 	    prevPtr->nextPtr = detPtr->nextPtr;
 	}
-	ckfree(detPtr);
+	ckfree((char *) detPtr);
 	detPtr = nextPtr;
     }
     Tcl_MutexUnlock(&pipeMutex);
@@ -247,126 +246,137 @@ Tcl_ReapDetachedProcs(void)
  *
  * TclCleanupChildren --
  *
- *	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.
+ *	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.
  *
  * 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(
-    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(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
 				 * stderr output. */
 {
     int result = TCL_OK;
     int i, abnormalExit, anyErrorInfo;
     Tcl_Pid pid;
-    int waitStatus;
-    const char *msg;
+    WAIT_STATUS_TYPE waitStatus;
+    CONST char *msg;
     unsigned long resolvedPid;
 
     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], &waitStatus, 0);
+        pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
 	if (pid == (Tcl_Pid) -1) {
 	    result = TCL_ERROR;
-	    if (interp != NULL) {
-		msg = Tcl_PosixError(interp);
-		if (errno == ECHILD) {
+            if (interp != (Tcl_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.
-		     */
-
-		    msg =
-			"child process lost (is SIGCHLD ignored or trapped?)";
-		}
-		Tcl_AppendResult(interp, "error waiting for process to exit: ",
-			msg, NULL);
-	    }
+                     * 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);
+            }
 	    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;
-	    sprintf(msg1, "%lu", resolvedPid);
+	    TclFormatInt(msg1, (long) resolvedPid);
 	    if (WIFEXITED(waitStatus)) {
-		if (interp != NULL) {
-		    sprintf(msg2, "%u", WEXITSTATUS(waitStatus));
-		    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
-		}
+                if (interp != (Tcl_Interp *) NULL) {
+		    TclFormatInt(msg2, WEXITSTATUS(waitStatus));
+                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
+                            (char *) NULL);
+                }
 		abnormalExit = 1;
-	    } else if (interp != NULL) {
-		const char *p;
-
-		if (WIFSIGNALED(waitStatus)) {
-		    p = Tcl_SignalMsg(WTERMSIG(waitStatus));
-		    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
-			    Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
-		    Tcl_AppendResult(interp, "child killed: ", p, "\n", NULL);
-		} else if (WIFSTOPPED(waitStatus)) {
-		    p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
-		    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
-			    Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
-		    Tcl_AppendResult(interp, "child suspended: ", p, "\n",
-			    NULL);
-		} else {
-		    Tcl_AppendResult(interp,
-			    "child wait status didn't make sense\n", NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
-			    "ODDWAITRESULT", msg1, NULL);
-		}
+	    } else if (WIFSIGNALED(waitStatus)) {
+                if (interp != (Tcl_Interp *) NULL) {
+                    CONST char *p;
+                    
+                    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;
+
+                    p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
+                    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
+                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
+                            p, (char *) NULL);
+                    Tcl_AppendResult(interp, "child suspended: ", p, "\n",
+                            (char *) NULL);
+                }
+	    } else {
+                if (interp != (Tcl_Interp *) NULL) {
+                    Tcl_AppendResult(interp,
+                            "child wait status didn't make sense\n",
+                            (char *) 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.
 	 */
 
-	if (interp != NULL) {
+        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);
@@ -388,12 +398,13 @@ TclCleanupChildren(
     }
 
     /*
-     * 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", NULL);
+	Tcl_AppendResult(interp, "child process exited abnormally",
+		(char *) NULL);
     }
     return result;
 }
@@ -403,23 +414,25 @@ TclCleanupChildren(
  *
  * 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 function is unofficially exported for use by BLT.
+ *	This procedure 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.
@@ -428,70 +441,71 @@ TclCleanupChildren(
  */
 
 int
-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
+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
 				 * 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
-				 * closed when cleaning up. */
+    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
-				 * closed when cleaning up. */
+    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
-				 * closed when cleaning up. */
+    int errorClose = 0;		/* If non-zero, then errorFile should be 
+    				 * closed when cleaning up. */
     int errorRelease = 0;
-    const char *p;
-    const char *nextArg;
+    CONST char *p;
+    CONST char *nextArg;
     int skip, lastBar, lastArg, i, j, atOK, flags, needCmd, errorToOutput = 0;
     Tcl_DString execBuffer;
     TclFile pipeIn;
@@ -509,23 +523,23 @@ TclCreatePipeline(
     }
 
     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;
@@ -542,10 +556,9 @@ TclCreatePipeline(
 	    }
 	    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);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
-			    "PIPESYNTAX", NULL);
 		    goto error;
 		}
 	    }
@@ -571,9 +584,7 @@ TclCreatePipeline(
 		    inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
 		    if (inputLiteral == NULL) {
 			Tcl_AppendResult(interp, "can't specify \"", argv[i],
-				"\" as last word in command", NULL);
-			Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
-				"PIPESYNTAX", NULL);
+				"\" as last word in command", (char *) NULL);
 			goto error;
 		    }
 		    skip = 2;
@@ -581,8 +592,8 @@ TclCreatePipeline(
 	    } 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;
 		}
@@ -613,8 +624,8 @@ TclCreatePipeline(
 	    }
 
 	    /*
-	     * 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) {
@@ -634,8 +645,8 @@ TclCreatePipeline(
 		}
 	    }
 	    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;
 	    }
@@ -675,15 +686,12 @@ TclCreatePipeline(
 	    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", NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
-			    "PIPESYNTAX", NULL);
+			    "\" as last word in command", (char *) NULL);
 		    goto error;
 		}
 		errorFile = outputFile;
@@ -691,7 +699,7 @@ TclCreatePipeline(
 		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;
@@ -700,12 +708,9 @@ TclCreatePipeline(
 	    break;
 
 	default:
-	    /*
-	     * Got a command word, not a redirection.
-	     */
-
-	    needCmd = 0;
-	    break;
+	  /* Got a command word, not a redirection */
+	  needCmd = 0;
+	  break;
 	}
 
 	if (skip != 0) {
@@ -718,14 +723,11 @@ TclCreatePipeline(
     }
 
     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",
-		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
-		NULL);
+        Tcl_SetResult(interp,
+		      "illegal use of | or |& in command",
+		      TCL_STATIC);
 	goto error;
     }
 
@@ -733,28 +735,27 @@ TclCreatePipeline(
 	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), NULL);
+			Tcl_PosixError(interp), (char *) 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), NULL);
+			Tcl_PosixError(interp), (char *) NULL);
 		goto error;
 	    }
 	    inputClose = 1;
@@ -776,14 +777,14 @@ TclCreatePipeline(
     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), NULL);
+			Tcl_PosixError(interp), (char *) NULL);
 		goto error;
 	    }
 	    outputClose = 1;
@@ -805,17 +806,16 @@ TclCreatePipeline(
     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 +823,7 @@ TclCreatePipeline(
 	    if (errorFile == NULL) {
 		Tcl_AppendResult(interp,
 			"couldn't create error file for command: ",
-			Tcl_PosixError(interp), NULL);
+			Tcl_PosixError(interp), (char *) NULL);
 		goto error;
 	    }
 	    *errFilePtr = errorFile;
@@ -841,24 +841,24 @@ TclCreatePipeline(
 	    }
 	}
     }
-
+	
     /*
-     * 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();
-    pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid));
+    pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
 
     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;
+	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,21 +871,20 @@ TclCreatePipeline(
 
 	joinThisError = 0;
 	for (lastArg = i; lastArg < argc; lastArg++) {
-	    if (argv[lastArg][0] != '|') {
-		continue;
-	    }
-	    if (argv[lastArg][1] == '\0') {
-		break;
-	    }
-	    if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
-		joinThisError = 1;
-		break;
+	    if (argv[lastArg][0] == '|') { 
+		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.
 	 */
 
@@ -895,7 +894,7 @@ TclCreatePipeline(
 	    argv[lastArg] = NULL;
 	    if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
 		Tcl_AppendResult(interp, "couldn't create pipe: ",
-			Tcl_PosixError(interp), NULL);
+			Tcl_PosixError(interp), (char *) NULL);
 		goto error;
 	    }
 	}
@@ -910,7 +909,7 @@ TclCreatePipeline(
 	 * 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,
@@ -925,8 +924,8 @@ TclCreatePipeline(
 	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)) {
@@ -944,10 +943,10 @@ TclCreatePipeline(
     *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) {
@@ -968,12 +967,12 @@ TclCreatePipeline(
     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);
     }
@@ -1001,7 +1000,7 @@ TclCreatePipeline(
 		Tcl_DetachPids(1, &pidPtr[i]);
 	    }
 	}
-	ckfree(pidPtr);
+	ckfree((char *) pidPtr);
     }
     numPids = -1;
     goto cleanup;
@@ -1012,26 +1011,28 @@ TclCreatePipeline(
  *
  * 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.
@@ -1040,12 +1041,12 @@ TclCreatePipeline(
  */
 
 Tcl_Channel
-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_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_STDERR, and TCL_ENFORCE_MODE. */
 {
     TclFile *inPipePtr, *outPipePtr, *errFilePtr;
@@ -1059,51 +1060,46 @@ Tcl_OpenCommandChannel(
     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);
+            outPipePtr, errFilePtr);
 
     if (numPids < 0) {
 	goto error;
     }
 
     /*
-     * 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", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
-		    "BADREDIRECT", NULL);
+	    Tcl_AppendResult(interp, "can't read output from command:",
+		    " standard output was redirected", (char *) NULL);
 	    goto error;
 	}
 	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
-	    Tcl_AppendResult(interp, "can't write input to command:"
-		    " standard input was redirected", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
-		    "BADREDIRECT", NULL);
+	    Tcl_AppendResult(interp, "can't write input to command:",
+		    " standard input was redirected", (char *) NULL);
 	    goto error;
 	}
     }
-
+    
     channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
 	    numPids, pidPtr);
 
-    if (channel == NULL) {
-	Tcl_AppendResult(interp, "pipe for command could not be created",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
+    if (channel == (Tcl_Channel) NULL) {
+        Tcl_AppendResult(interp, "pipe for command could not be created",
+                (char *) NULL);
 	goto error;
     }
     return channel;
 
-  error:
+error:
     if (numPids > 0) {
 	Tcl_DetachPids(numPids, pidPtr);
-	ckfree(pidPtr);
+	ckfree((char *) pidPtr);
     }
     if (inPipe != NULL) {
 	TclpCloseFile(inPipe);
@@ -1116,11 +1112,3 @@ Tcl_OpenCommandChannel(
     }
     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 fdaea57..940d011 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,60 +18,70 @@
 #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. */
-    const void *clientData;	/* Client data. */
+    PkgAvail *availPtr;		/* First in list of all available versions
+				 * of this package. */
+    ClientData clientData;	/* Client data. */
 } Package;
 
 /*
- * Prototypes for functions defined in this file:
+ * Prototypes for procedures 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(char *v1i, char *v2i,
+			    CONST char *string, char** internal, int* stable);
+static int		CompareVersions(CONST char *v1i, CONST 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 reqc, Tcl_Obj *const reqv[],
-			    void *clientDataPtr);
+			    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[],
+			    ClientData *clientDataPtr);
+#endif
 
 /*
  * Helper macros.
@@ -84,50 +94,56 @@ 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 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.
+ *	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.
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
+Tcl_PkgProvide(interp, name, version)
+     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, NULL);
+    return Tcl_PkgProvideEx(interp, name, version, (ClientData) NULL);
 }
 
 int
-Tcl_PkgProvideEx(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
+Tcl_PkgProvideEx(interp, name, version, clientData)
+     Tcl_Interp *interp;	/* Interpreter in which package is now
 				 * available. */
-    const char *name,		/* Name of package. */
-    const char *version,	/* Version string for package. */
-    const void *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;
-    char *pvi, *vi;
+#ifdef TCL_TIP268
+    char* pvi;
+    char* vi;
     int res;
+#endif
 
     pkgPtr = FindPackage(interp, name);
     if (pkgPtr->version == NULL) {
@@ -135,11 +151,12 @@ Tcl_PkgProvideEx(
 	pkgPtr->clientData = clientData;
 	return TCL_OK;
     }
-
-    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
-	    NULL) != TCL_OK) {
+#ifndef TCL_TIP268
+    if (ComparePkgVersions(pkgPtr->version, version, (int *) NULL) == 0) {
+#else
+    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;
     }
@@ -149,14 +166,14 @@ Tcl_PkgProvideEx(
     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, NULL);
-    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
+		     name, "\": ", pkgPtr->version, ", then ", version, (char *) NULL);
     return TCL_ERROR;
 }
 
@@ -165,135 +182,166 @@ Tcl_PkgProvideEx(
  *
  * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc --
  *
- *	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.
+ *	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.
  *
  * 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.
  *
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_PkgRequire(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
+#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. */
-    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. */
+     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_PkgRequireEx(interp, name, version, exact, NULL);
+    return TCL_ERROR;
 }
+#endif
 
-const char *
-Tcl_PkgRequireEx(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
+CONST char *
+Tcl_PkgRequire(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
+     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. */
-    void *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. */
 {
+    return Tcl_PkgRequireEx(interp, name, version, exact, (ClientData *) 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
+				 * 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;
+    CONST char *result = NULL;
+#endif
 
     /*
      * 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) {
+
 	/*
 	 * 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);
-	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
-	return NULL;
+        Tcl_AppendResult(interp, "Cannot load package \"", name, 
+			 "\" in standalone executable: This package is not ",
+			 "compiled with stub support", NULL);
+        return NULL;
     }
 
-    /*
-     * Translate between old and new API, and defer to the new function.
-     */
+#ifdef TCL_TIP268
+    /* Translate between old and new API, and defer to the new function. */
 
     if (version == NULL) {
 	result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
@@ -306,9 +354,9 @@ Tcl_PkgRequireEx(
 	if (exact) {
 	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
 	}
-	Tcl_IncrRefCount(ov);
+	Tcl_IncrRefCount (ov);
 	result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
-	TclDecrRefCount(ov);
+	Tcl_DecrRefCount (ov);
     }
 
     return result;
@@ -316,16 +364,16 @@ Tcl_PkgRequireEx(
 
 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. */
-    void *clientDataPtr)
+     ClientData *clientDataPtr)
 {
-    const char *result =
+    CONST char *result =
 	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
 
     if (result == NULL) {
@@ -335,26 +383,28 @@ 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. */
-    void *clientDataPtr)
+     ClientData *clientDataPtr)
 {
     Interp *iPtr = (Interp *) interp;
     Package *pkgPtr;
     PkgAvail *availPtr, *bestPtr, *bestStablePtr;
-    char *availVersion, *bestVersion;
-				/* Internal rep. of versions */
-    int availStable, code, satisfies, pass;
-    char *script, *pkgVersionI;
+    char *availVersion, *bestVersion;	/* Internal rep. of versions */
+    int availStable;
+    char *script;
+    int code, satisfies, pass;
     Tcl_DString command;
+    char* pkgVersionI;
 
+#endif
     /*
      * 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
@@ -362,33 +412,45 @@ 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);
-	    AddRequirementsToResult(interp, reqc, reqv);
-	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
+		    (char *)(pkgPtr->clientData), " requires ", name, NULL);
+#ifndef TCL_TIP268
+	    if (version != NULL) {
+		Tcl_AppendResult(interp, " ", version, NULL);
+	    }
+#else
+	    AddRequirementsToResult (interp, reqc, reqv);
+#endif
 	    return NULL;
 	}
 
 	/*
 	 * The package isn't yet present. Search the list of available
-	 * 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.
+	 * 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.
 	 */
-
+#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;
@@ -397,55 +459,60 @@ 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);
-
-		/*
-		 * Note: Use internal reps!
-		 */
+		int res = CompareVersions (availVersion, bestVersion, NULL);
 
+		/* 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.
-	     */
+	    /* We have found a version which is better than our max. */
 
 	    if (reqc > 0) {
 		/* 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
@@ -458,11 +525,10 @@ 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.
 	 */
@@ -470,8 +536,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
@@ -480,28 +546,71 @@ PkgRequireCore(
 	     * will still exist when the script completes.
 	     */
 
-	    char *versionToProvide = bestPtr->version;
+	    CONST char *versionToProvide = bestPtr->version;
 	    script = bestPtr->script;
 
-	    pkgPtr->clientData = versionToProvide;
-	    Tcl_Preserve(script);
-	    Tcl_Preserve(versionToProvide);
+	    pkgPtr->clientData = (ClientData) versionToProvide;
+	    Tcl_Preserve((ClientData) script);
+	    Tcl_Preserve((ClientData) versionToProvide);
 	    code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
-	    Tcl_Release(script);
+	    Tcl_Release((ClientData) script);
 
 	    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);
-		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
-			    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) {
@@ -511,40 +620,67 @@ PkgRequireCore(
 			ckfree(pvi);
 			code = TCL_ERROR;
 		    } else {
-			int res = CompareVersions(pvi, vi, NULL);
-
-			ckfree(pvi);
+			res = CompareVersions(pvi, vi, NULL);
 			ckfree(vi);
+
 			if (res != 0) {
-			    code = TCL_ERROR;
-			    Tcl_AppendResult(interp,
-				    "attempt to provide package ", name, " ",
-				    versionToProvide, " failed: package ",
-				    name, " ", pkgPtr->version,
-				    " provided instead", NULL);
-			    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
-				    "WRONGPROVIDE", 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 (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
 			}
+#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: ",
-			TclGetString(codePtr), NULL);
-		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
-		TclDecrRefCount(codePtr);
+		Tcl_AppendResult(interp, "attempt to provide package ",
+			name, " ", versionToProvide, " failed: ",
+			"bad return code: ", Tcl_GetString(codePtr), NULL);
+		Tcl_DecrRefCount(codePtr);
 		code = TCL_ERROR;
 	    }
 
-	    if (code == TCL_ERROR) {
-		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (\"package ifneeded %s %s\" script)",
-			name, versionToProvide));
-	    }
-	    Tcl_Release(versionToProvide);
+	    Tcl_Release((ClientData) versionToProvide);
 
 	    if (code != TCL_OK) {
 		/*
@@ -552,12 +688,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;
@@ -584,25 +720,30 @@ 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: ",
-			TclGetString(codePtr), NULL);
-		Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
+			Tcl_GetString(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);
@@ -610,9 +751,14 @@ PkgRequireCore(
     }
 
     if (pkgPtr->version == NULL) {
-	Tcl_AppendResult(interp, "can't find package ", name, NULL);
-	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
+	Tcl_AppendResult(interp, "can't find package ", name, (char *) NULL);
+#ifndef TCL_TIP268
+	if (version != NULL) {
+	    Tcl_AppendResult(interp, " ", version, (char *) NULL);
+	}
+#else
 	AddRequirementsToResult(interp, reqc, reqv);
+#endif
 	return NULL;
     }
 
@@ -621,28 +767,42 @@ PkgRequireCore(
      * provided version meets the current requirements.
      */
 
-    if (reqc != 0) {
+#ifndef TCL_TIP268
+    if (version == NULL) {
+        if (clientDataPtr) {
+	    *clientDataPtr = pkgPtr->clientData;
+	}
+	return pkgPtr->version;
+#else
+    if (reqc == 0) {
+	satisfies = 1;
+    } else {
 	CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
 	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
 
 	ckfree(pkgVersionI);
-
-	if (!satisfies) {
-	    Tcl_AppendResult(interp, "version conflict for package \"", name,
-		    "\": have ", pkgPtr->version, ", need", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
-		    NULL);
-	    AddRequirementsToResult(interp, reqc, reqv);
-	    return NULL;
-	}
+#endif
     }
-
-    if (clientDataPtr) {
-	const void **ptr = (const void **) clientDataPtr;
-
-	*ptr = pkgPtr->clientData;
+#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;
     }
-    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
+    return NULL;
 }
 
 /*
@@ -650,15 +810,16 @@ 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.
@@ -666,34 +827,36 @@ PkgRequireCore(
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_PkgPresent(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
+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 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, NULL);
+    return Tcl_PkgPresentEx(interp, name, version, exact, (ClientData *) NULL);
 }
 
-const char *
-Tcl_PkgPresentEx(
-    Tcl_Interp *interp,		/* Interpreter in which package is now
+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 available. */
-    int exact,			/* Non-zero means that only the particular
-				 * version given is acceptable. Zero means use
-				 * the latest compatible version. */
-    void *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;
@@ -701,22 +864,17 @@ Tcl_PkgPresentEx(
 
     hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
     if (hPtr) {
-	pkgPtr = Tcl_GetHashValue(hPtr);
+	pkgPtr = (Package *) 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.
 	     */
 
-	    const char *foundVersion = Tcl_PkgRequireEx(interp, name, version,
-		    exact, clientDataPtr);
-
-	    if (foundVersion == NULL) {
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name,
-			NULL);
-	    }
-	    return foundVersion;
+	    return Tcl_PkgRequireEx(interp, name, version, exact,
+		    clientDataPtr);
 	}
     }
 
@@ -726,7 +884,6 @@ Tcl_PkgPresentEx(
     } else {
 	Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
     }
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
     return NULL;
 }
 
@@ -735,8 +892,8 @@ Tcl_PkgPresentEx(
  *
  * Tcl_PackageObjCmd --
  *
- *	This function is invoked to process the "package" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "package" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -747,23 +904,29 @@ Tcl_PkgPresentEx(
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
+/* ARGSUSED */
 int
-Tcl_PackageObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    static const char *const pkgOptions[] = {
-	"forget",  "ifneeded", "names",   "prefer",   "present",
-	"provide", "require",  "unknown", "vcompare", "versions",
-	"vsatisfies", NULL
+    static CONST char *pkgOptions[] = {
+	"forget", "ifneeded", "names",
+#ifdef TCL_TIP268
+	"prefer",
+#endif
+	"present", "provide", "require", "unknown", "vcompare",
+	"versions", "vsatisfies", (char *) NULL
     };
     enum pkgOptions {
-	PKG_FORGET,  PKG_IFNEEDED, PKG_NAMES,   PKG_PREFER,   PKG_PRESENT,
-	PKG_PROVIDE, PKG_REQUIRE,  PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS,
-	PKG_VSATISFIES
+	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
     };
     Interp *iPtr = (Interp *) interp;
     int optionIndex, exact, i, satisfies;
@@ -772,30 +935,32 @@ Tcl_PackageObjCmd(
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
     Tcl_HashTable *tablePtr;
-    const char *version;
-    const char *argv2, *argv3, *argv4;
-    char *iva = NULL, *ivb = NULL;
+    CONST char *version;
+    char *argv2, *argv3, *argv4;
+#ifdef TCL_TIP268
+    char* iva = NULL;
+    char* ivb = NULL;
+#endif
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?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: {
-	const char *keyString;
-
+	char *keyString;
 	for (i = 2; i < objc; i++) {
-	    keyString = TclGetString(objv[i]);
+	    keyString = Tcl_GetString(objv[i]);
 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
 	    if (hPtr == NULL) {
-		continue;
+		continue;	
 	    }
-	    pkgPtr = Tcl_GetHashValue(hPtr);
+	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
 	    Tcl_DeleteHashEntry(hPtr);
 	    if (pkgPtr->version != NULL) {
 		ckfree(pkgPtr->version);
@@ -803,41 +968,52 @@ Tcl_PackageObjCmd(
 	    while (pkgPtr->availPtr != NULL) {
 		availPtr = pkgPtr->availPtr;
 		pkgPtr->availPtr = availPtr->nextPtr;
-		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
-		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
-		ckfree(availPtr);
+		Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
+		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+		ckfree((char *) availPtr);
 	    }
-	    ckfree(pkgPtr);
+	    ckfree((char *) pkgPtr);
 	}
 	break;
     }
     case PKG_IFNEEDED: {
-	int length, res;
+	int length;
+#ifdef TCL_TIP268
+	int res;
 	char *argv3i, *avi;
+#endif
 
 	if ((objc != 4) && (objc != 5)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
 	    return TCL_ERROR;
 	}
-	argv3 = TclGetString(objv[3]);
+	argv3 = Tcl_GetString(objv[3]);
+#ifdef TCL_TIP268
 	if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {
+#else
+	if (CheckVersion(interp, argv3) != TCL_OK) {
+#endif
 	    return TCL_ERROR;
 	}
-	argv2 = TclGetString(objv[2]);
+	argv2 = Tcl_GetString(objv[2]);
 	if (objc == 4) {
 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
 	    if (hPtr == NULL) {
+#ifdef TCL_TIP268
 		ckfree(argv3i);
+#endif
 		return TCL_OK;
 	    }
-	    pkgPtr = Tcl_GetHashValue(hPtr);
+	    pkgPtr = (Package *) 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) {
+	     prevPtr = availPtr, availPtr = availPtr->nextPtr) {
+
+#ifdef TCL_TIP268
 	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
 		    NULL) != TCL_OK) {
 		ckfree(argv3i);
@@ -848,22 +1024,29 @@ Tcl_PackageObjCmd(
 	    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;
 		}
-		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
 		break;
 	    }
 	}
+#ifdef TCL_TIP268
 	ckfree(argv3i);
-
+#endif
 	if (objc == 4) {
 	    return TCL_OK;
 	}
 	if (availPtr == NULL) {
-	    availPtr = ckalloc(sizeof(PkgAvail));
+	    availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
 	    DupBlock(availPtr->version, argv3, (unsigned) length + 1);
 
 	    if (prevPtr == NULL) {
@@ -878,33 +1061,27 @@ Tcl_PackageObjCmd(
 	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;
-	} else {
-	    Tcl_Obj *resultObj;
-
-	    resultObj = Tcl_NewObj();
-	    tablePtr = &iPtr->packageTable;
-	    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
-		    hPtr = Tcl_NextHashEntry(&search)) {
-		pkgPtr = Tcl_GetHashValue(hPtr);
-		if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
-		    Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj(
-			    Tcl_GetHashKey(tablePtr, hPtr), -1));
-		}
+	}
+	tablePtr = &iPtr->packageTable;
+	for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
+	     hPtr = Tcl_NextHashEntry(&search)) {
+	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
+		Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
 	    }
-	    Tcl_SetObjResult(interp, resultObj);
 	}
 	break;
+    }
     case PKG_PRESENT: {
-	const char *name;
-
+	CONST char *name;
 	if (objc < 3) {
 	    goto require;
 	}
-	argv2 = TclGetString(objv[2]);
+	argv2 = Tcl_GetString(objv[2]);
 	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
 	    if (objc != 5) {
 		goto requireSyntax;
@@ -923,98 +1100,138 @@ Tcl_PackageObjCmd(
 		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 = TclGetString(objv[4]);
-	    if (CheckVersionAndConvert(interp, version, NULL,
-		    NULL) != TCL_OK) {
+	    version = Tcl_GetString(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 = TclGetString(objv[2]);
+	argv2 = Tcl_GetString(objv[2]);
 	if (objc == 3) {
 	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
 	    if (hPtr != NULL) {
-		pkgPtr = Tcl_GetHashValue(hPtr);
+		pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
 		if (pkgPtr->version != NULL) {
 		    Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
 		}
 	    }
 	    return TCL_OK;
 	}
-	argv3 = TclGetString(objv[3]);
+	argv3 = Tcl_GetString(objv[3]);
+#ifndef TCL_TIP268
+	if (CheckVersion(interp, argv3) != TCL_OK) {
+#else
 	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 ...?");
+		    "?-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;
-
-	argv2 = TclGetString(objv[2]);
+	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]);
 	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
-	    Tcl_Obj *ov;
+	    Tcl_Obj* ov;
 	    int res;
 
 	    if (objc != 5) {
 		goto requireSyntax;
 	    }
-
-	    version = TclGetString(objv[4]);
-	    if (CheckVersionAndConvert(interp, version, NULL,
-		    NULL) != TCL_OK) {
+	    version = Tcl_GetString(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 = TclGetString(objv[3]);
+	    argv3   = Tcl_GetString(objv[3]);
 
-	    Tcl_IncrRefCount(ov);
+	    Tcl_IncrRefCount (ov);
 	    res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
-	    TclDecrRefCount(ov);
+	    Tcl_DecrRefCount (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);
@@ -1027,7 +1244,7 @@ Tcl_PackageObjCmd(
 	    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?");
@@ -1035,102 +1252,94 @@ Tcl_PackageObjCmd(
 	}
 	break;
     }
+#ifdef TCL_TIP268
     case PKG_PREFER: {
-	static const char *const pkgPreferOptions[] = {
+	/* See tclInt.h for the enum, just before Interp */
+	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) {
-	    /*
-	     * Seting the value.
-	     */
-
-	    int newPref;
-
+	    /* Set value. */
+	    int new;
 	    if (Tcl_GetIndexFromObj(interp, objv[2], pkgPreferOptions,
-		    "preference", 0, &newPref) != TCL_OK) {
+		    "preference", 0, &new) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-
-	    if (newPref < iPtr->packagePrefer) {
-		iPtr->packagePrefer = newPref;
+	    if (new < iPtr->packagePrefer) {
+		iPtr->packagePrefer = new;
 	    }
 	}
-
-	/*
-	 * Always return current value.
-	 */
-
+	/* Always return current value. */
 	Tcl_SetObjResult(interp,
 		Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], -1));
 	break;
     }
-    case PKG_VCOMPARE:
+#endif
+    case PKG_VCOMPARE: {
 	if (objc != 4) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "version1 version2");
 	    return TCL_ERROR;
 	}
-	argv3 = TclGetString(objv[3]);
-	argv2 = TclGetString(objv[2]);
-	if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK ||
-		CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) {
+	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)) {
 	    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;
-	} else {
-	    Tcl_Obj *resultObj = Tcl_NewObj();
-
-	    argv2 = TclGetString(objv[2]);
-	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
-	    if (hPtr != NULL) {
-		pkgPtr = Tcl_GetHashValue(hPtr);
-		for (availPtr = pkgPtr->availPtr; availPtr != NULL;
-			availPtr = availPtr->nextPtr) {
-		    Tcl_ListObjAppendElement(NULL, resultObj,
-			    Tcl_NewStringObj(availPtr->version, -1));
-		}
+	}
+	argv2 = Tcl_GetString(objv[2]);
+	hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
+	if (hPtr != NULL) {
+	    pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
+	    for (availPtr = pkgPtr->availPtr; availPtr != NULL;
+		 availPtr = availPtr->nextPtr) {
+		Tcl_AppendElement(interp, availPtr->version);
 	    }
-	    Tcl_SetObjResult(interp, resultObj);
 	}
 	break;
+    }
     case PKG_VSATISFIES: {
-	char *argv2i = NULL;
+#ifdef TCL_TIP268
+	char* argv2i = NULL;
 
 	if (objc < 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?");
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "version requirement requirement...");
 	    return TCL_ERROR;
 	}
 
-	argv2 = TclGetString(objv[2]);
-	if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) {
+	argv2 = Tcl_GetString(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);
@@ -1138,13 +1347,27 @@ Tcl_PackageObjCmd(
 	}
 
 	satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
-	ckfree(argv2i);
+	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
 
-	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(satisfies));
 	break;
     }
-    default:
-	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
+    default: {
+	panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
+    }
     }
     return TCL_OK;
 }
@@ -1154,12 +1377,13 @@ Tcl_PackageObjCmd(
  *
  * FindPackage --
  *
- *	This function finds the Package record for a particular package in a
- *	particular interpreter, creating a record if one doesn't already
- *	exist.
+ *	This procedure 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.
@@ -1168,24 +1392,24 @@ Tcl_PackageObjCmd(
  */
 
 static Package *
-FindPackage(
-    Tcl_Interp *interp,		/* Interpreter to use for package lookup. */
-    const char *name)		/* Name of package to fine. */
+FindPackage(interp, name)
+     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 isNew;
+    int new;
     Package *pkgPtr;
 
-    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
-    if (isNew) {
-	pkgPtr = ckalloc(sizeof(Package));
+    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &new);
+    if (new) {
+	pkgPtr = (Package *) ckalloc(sizeof(Package));
 	pkgPtr->version = NULL;
 	pkgPtr->availPtr = NULL;
 	pkgPtr->clientData = NULL;
 	Tcl_SetHashValue(hPtr, pkgPtr);
     } else {
-	pkgPtr = Tcl_GetHashValue(hPtr);
+	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
     }
     return pkgPtr;
 }
@@ -1195,8 +1419,9 @@ FindPackage(
  *
  * TclFreePackageInfo --
  *
- *	This function is called during interpreter deletion to free all of the
- *	package-related information for the interpreter.
+ *	This procedure is called during interpreter deletion to
+ *	free all of the package-related information for the
+ *	interpreter.
  *
  * Results:
  *	None.
@@ -1208,8 +1433,8 @@ FindPackage(
  */
 
 void
-TclFreePackageInfo(
-    Interp *iPtr)		/* Interpereter that is being deleted. */
+TclFreePackageInfo(iPtr)
+     Interp *iPtr;	/* Interpreter that is being deleted. */
 {
     Package *pkgPtr;
     Tcl_HashSearch search;
@@ -1217,19 +1442,19 @@ TclFreePackageInfo(
     PkgAvail *availPtr;
 
     for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
-	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
-	pkgPtr = Tcl_GetHashValue(hPtr);
+	 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+	pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
 	if (pkgPtr->version != NULL) {
 	    ckfree(pkgPtr->version);
 	}
 	while (pkgPtr->availPtr != NULL) {
 	    availPtr = pkgPtr->availPtr;
 	    pkgPtr->availPtr = availPtr->nextPtr;
-	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
-	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
-	    ckfree(availPtr);
+	    Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
+	    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
+	    ckfree((char *) availPtr);
 	}
-	ckfree(pkgPtr);
+	ckfree((char *) pkgPtr);
     }
     Tcl_DeleteHashTable(&iPtr->packageTable);
     if (iPtr->packageUnknown != NULL) {
@@ -1240,16 +1465,15 @@ TclFreePackageInfo(
 /*
  *----------------------------------------------------------------------
  *
- * CheckVersionAndConvert --
+ * CheckVersion / CheckVersionAndConvert --
  *
- *	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).
+ *	This procedure checks to see whether a version number has
+ *	valid syntax.
  *
  * 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.
@@ -1257,31 +1481,60 @@ TclFreePackageInfo(
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_TIP268
 static int
-CheckVersionAndConvert(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    const char *string,		/* Supposedly a version number, which is
+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
 				 * 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 '.'
@@ -1290,23 +1543,20 @@ CheckVersionAndConvert(
      * (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)) &&			/* INTL: digit */
-		((*p!='.' && *p!='a' && *p!='b') ||
-		((hasunstable && (*p=='a' || *p=='b')) ||
-		((prevChar=='a' || prevChar=='b' || prevChar=='.')
-			&& (*p=='.')) ||
-		((*p=='a' || *p=='b' || *p=='.') && prevChar=='.')))) {
+	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 */
 	    goto error;
 	}
-
-	if (*p == 'a' || *p == 'b') {
+	if ((*p == 'a') || (*p == 'b')) {
 	    hasunstable = 1;
 	}
 
@@ -1333,10 +1583,9 @@ CheckVersionAndConvert(
 	} else {
 	    *ip++ = *p;
 	}
-
 	prevChar = *p;
     }
-    if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
+    if ((prevChar != '.') && (prevChar != 'a') && (prevChar != 'b')) {
 	*ip = '\0';
 	if (internal != NULL) {
 	    *internal = ibuf;
@@ -1349,26 +1598,27 @@ CheckVersionAndConvert(
 	return TCL_OK;
     }
 
-  error:
+ error:
     ckfree(ibuf);
-    Tcl_AppendResult(interp, "expected version number but got \"", string,
-	    "\"", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
+    Tcl_AppendResult(interp, "expected version number but got \"",
+	    string, "\"", (char *) NULL);
     return TCL_ERROR;
 }
+#endif
 
 /*
  *----------------------------------------------------------------------
  *
- * CompareVersions --
+ * ComparePkgVersions / CompareVersions --
  *
- *	This function compares two version numbers (in internal rep).
+ *	This procedure compares two version numbers. (268: 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.
@@ -1376,157 +1626,142 @@ CheckVersionAndConvert(
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_TIP268
 static int
-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. */
+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. */
 {
-    int thisIsMajor, res, flip;
-    char *s1, *e1, *s2, *e2, o1, o2;
+    int thisIsMajor, n1, n2;
 
     /*
      * 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. Skip
-	 * leading zeros. Terminate found number for upcoming string-wise
-	 * comparison, if needed.
-	 */
+	/* Parse one decimal number from the front of each string. */
 
-	while ((*s1 != 0) && (*s1 == '0')) {
-	    s1++;
+	n1 = n2 = 0;
+	while ((*v1 != 0) && (*v1 != '.')) {
+	    n1 = 10*n1 + (*v1 - '0');
+	    v1++;
 	}
-	while ((*s2 != 0) && (*s2 == '0')) {
-	    s2++;
+	while ((*v2 != 0) && (*v2 != '.')) {
+	    n2 = 10*n2 + (*v2 - '0');
+	    v2++;
 	}
 
 	/*
-	 * 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.
+	 * Compare and go on to the next version number if the current numbers
+	 * match.
 	 */
 
-	if ((*s1 == '-') && (*s2 != '-')) {
-	    /* s1 < 0, s2 >= 0 => s1 < s2 */
-	    res = -1;
+	if (n1 != n2) {
 	    break;
 	}
-	if ((*s1 != '-') && (*s2 == '-')) {
-	    /* s1 >= 0, s2 < 0 => s1 > s2 */
-	    res = 1;
+	if (*v1 != 0) {
+	    v1++;
+	} else if (*v2 == 0) {
 	    break;
 	}
-
-	if ((*s1 == '-') && (*s2 == '-')) {
-	    /* a < b => -a > -b, etc. */
-	    s1++;
-	    s2++;
-	    flip = 1;
-	} else {
-	    flip = 0;
+	if (*v2 != 0) {
+	    v2++;
 	}
+	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;
 
-	/*
-	 * The string comparison is needed, so now we determine where the
-	 * numbers end.
-	 */
+    /*
+     * 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.
+     */
 
-	e1 = s1;
-	while ((*e1 != 0) && (*e1 != ' ')) {
-	    e1++;
+    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++;
 	}
-	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++;
 	}
+	if (flip) n2 = -n2;
 
 	/*
-	 * 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.
+	 * Compare and go on to the next version number if the current numbers
+	 * match.
 	 */
 
-	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;
-	}
-
-	/*
-	 * Stop comparing segments when a difference has been found. Here we
-	 * may have to flip the result to account for signs.
-	 */
-
-	if (res != 0) {
-	    if (flip) {
-		res = -res;
-	    }
+	if (n1 != n2) {
 	    break;
 	}
-
-	/*
-	 * 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;
+	if (*v1 != 0) {
+	    v1++;
+	} else if (*v2 == 0) {
 	    break;
 	}
-	if (*s2 != 0) {
-	    s2++;
+	if (*v2 != 0) {
+	    v2++;
 	}
 	thisIsMajor = 0;
     }
+    if (n1 > n2) {
+	res = 1;
+    } else if (n1 == n2) {
+	res = 0;
+    } else {
+	res = -1;
+    }
 
     if (isMajorPtr != NULL) {
 	*isMajorPtr = thisIsMajor;
@@ -1540,12 +1775,13 @@ CompareVersions(
  *
  * 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.
@@ -1554,15 +1790,14 @@ CompareVersions(
  */
 
 static int
-CheckAllRequirements(
-    Tcl_Interp *interp,
-    int reqc,			/* Requirements to check. */
-    Tcl_Obj *const reqv[])
+CheckAllRequirements(interp, reqc, reqv)
+     Tcl_Interp* interp;
+     int reqc;                   /* Requirements to check. */
+     Tcl_Obj *CONST reqv[];
 {
     int i;
-
     for (i = 0; i < reqc; i++) {
-	if ((CheckRequirement(interp, TclGetString(reqv[i])) != TCL_OK)) {
+	if ((CheckRequirement(interp, Tcl_GetString(reqv[i])) != TCL_OK)) {
 	    return TCL_ERROR;
 	}
     }
@@ -1588,53 +1823,43 @@ CheckAllRequirements(
  */
 
 static int
-CheckRequirement(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    const char *string)		/* Supposedly a requirement. */
+CheckRequirement(interp, string)
+     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, *buf;
+    char* dash = NULL;
+    char* 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);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", 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. Also note that the string allocated with strdup() must be
-     * freed with free() and not ckfree().
+     * be empty.
      */
 
     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;
     }
@@ -1660,23 +1885,20 @@ CheckRequirement(
  */
 
 static void
-AddRequirementsToResult(
-    Tcl_Interp *interp,
-    int reqc,			/* Requirements constraining the desired
-				 * version. */
-    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
-				 * available. */
+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. */
 {
     if (reqc > 0) {
 	int i;
-
 	for (i = 0; i < reqc; i++) {
 	    int length;
-	    const char *v = Tcl_GetStringFromObj(reqv[i], &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, " exactly ", v+((length+1)/2), NULL);
+		Tcl_AppendResult(interp, " ", v+((length+1)/2), NULL);
 	    } else {
 		Tcl_AppendResult(interp, " ", v, NULL);
 	    }
@@ -1701,22 +1923,19 @@ AddRequirementsToResult(
  */
 
 static void
-AddRequirementsToDString(
-    Tcl_DString *dsPtr,
-    int reqc,			/* Requirements constraining the desired
-				 * version. */
-    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
-				 * available. */
+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. */
 {
     if (reqc > 0) {
 	int i;
-
 	for (i = 0; i < reqc; i++) {
-	    Tcl_DStringAppend(dsPtr, " ", 1);
-	    Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
+	    Tcl_DStringAppend(dstring, " ", 1);
+	    Tcl_DStringAppend(dstring, TclGetString(reqv[i]), -1);
 	}
     } else {
-	Tcl_DStringAppend(dsPtr, " 0-", -1);
+	Tcl_DStringAppend(dstring, " 0-", -1);
     }
 }
 
@@ -1725,13 +1944,14 @@ AddRequirementsToDString(
  *
  * 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.
@@ -1740,18 +1960,17 @@ AddRequirementsToDString(
  */
 
 static int
-SomeRequirementSatisfied(
-    char *availVersionI,	/* Candidate version to check against the
+SomeRequirementSatisfied(availVersionI, reqc, reqv)
+     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 to use the latest version
-				 * available. */
+     Tcl_Obj *CONST reqv[];	/* 0 means use the latest version available. */
 {
     int i;
 
     for (i = 0; i < reqc; i++) {
-	if (RequirementSatisfied(availVersionI, TclGetString(reqv[i]))) {
+	if (RequirementSatisfied(availVersionI, Tcl_GetString(reqv[i]))) {
 	    return 1;
 	}
     }
@@ -1766,9 +1985,10 @@ SomeRequirementSatisfied(
  *	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.
@@ -1777,80 +1997,75 @@ SomeRequirementSatisfied(
  */
 
 static int
-RequirementSatisfied(
-    char *havei,		/* Version string, of candidate package we
-				 * have. */
-    const char *req)		/* Requirement string the candidate has to
-				 * satisfy. */
+RequirementSatisfied(havei, req)
+     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, *buf, *min, *max;
+    char* dash = NULL;
+    char* 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'.
 	 */
 
-	CheckVersionAndConvert(NULL, buf, &min, NULL);
-	strcat(min, " -2");
+	/* No max part, unbound */
+
+	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);
@@ -1860,55 +2075,10 @@ RequirementSatisfied(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * 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
deleted file mode 100644
index 466d535..0000000
--- a/generic/tclPkgConfig.c
+++ /dev/null
@@ -1,135 +0,0 @@
-/*
- * 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 const 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 37f5479..7580f9c 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -10,34 +10,22 @@
 #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
-
 /*
- * 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/tcl.decls script.
+ *  Pull in the typedef of TCHAR for windows.
  */
-
-/*
- * 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.
- */
-#if defined(_WIN32) && !defined(_TCHAR_DEFINED)
-#   if defined(_UNICODE)
-	typedef wchar_t TCHAR;
-#   else
-	typedef char TCHAR;
+#if defined(__CYGWIN__)
+    typedef char TCHAR;
+#elif defined(__WIN32__) && !defined(_TCHAR_DEFINED)
+#   include <tchar.h>
+#   ifndef _TCHAR_DEFINED
+	/* Borland seems to forget to set this. */
+        typedef _TCHAR TCHAR;
+#	define _TCHAR_DEFINED
+#   endif
+#   if defined(_MSC_VER) && defined(__STDC__)
+	/* MSVC++ misses this. */
+	typedef _TCHAR TCHAR;
 #   endif
-#   define _TCHAR_DEFINED
 #endif
 
 /* !BEGIN!: Do not edit below this line. */
@@ -46,97 +34,161 @@
  * Exported function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
 /* 0 */
-EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
-				const char *bundleName, int hasResourceFile,
-				int maxPathLen, char *libraryPath);
+EXTERN int		Tcl_MacOSXOpenBundleResources _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *bundleName,
+				int hasResourceFile, int maxPathLen,
+				char *libraryPath));
 /* 1 */
-EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
-				Tcl_Interp *interp, const char *bundleName,
-				const char *bundleVersion,
+EXTERN int		Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_((
+				Tcl_Interp *interp, CONST char *bundleName,
+				CONST char *bundleVersion,
 				int hasResourceFile, int maxPathLen,
-				char *libraryPath);
+				char *libraryPath));
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#ifdef __WIN32__
 /* 0 */
-EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
-				Tcl_DString *dsPtr);
+EXTERN TCHAR *		Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char *str,
+				int len, Tcl_DString *dsPtr));
 /* 1 */
-EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
-				Tcl_DString *dsPtr);
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
+EXTERN char *		Tcl_WinTCharToUtf _ANSI_ARGS_((CONST TCHAR *str,
+				int len, Tcl_DString *dsPtr));
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
 /* 0 */
-EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
-				const char *bundleName, int hasResourceFile,
-				int maxPathLen, char *libraryPath);
+EXTERN void		Tcl_MacSetEventProc _ANSI_ARGS_((
+				Tcl_MacConvertEventPtr procPtr));
 /* 1 */
-EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
-				Tcl_Interp *interp, const char *bundleName,
-				const char *bundleVersion,
-				int hasResourceFile, int maxPathLen,
-				char *libraryPath);
-#endif /* MACOSX */
+EXTERN char *		Tcl_MacConvertTextResource _ANSI_ARGS_((
+				Handle resource));
+/* 2 */
+EXTERN int		Tcl_MacEvalResource _ANSI_ARGS_((Tcl_Interp *interp,
+				CONST char *resourceName, int resourceNumber,
+				CONST char *fileName));
+/* 3 */
+EXTERN Handle		Tcl_MacFindResource _ANSI_ARGS_((Tcl_Interp *interp,
+				long resourceType, CONST char *resourceName,
+				int resourceNumber, CONST char *resFileRef,
+				int *releaseIt));
+/* 4 */
+EXTERN int		Tcl_GetOSTypeFromObj _ANSI_ARGS_((Tcl_Interp *interp,
+				Tcl_Obj *objPtr, OSType *osTypePtr));
+/* 5 */
+EXTERN void		Tcl_SetOSTypeObj _ANSI_ARGS_((Tcl_Obj *objPtr,
+				OSType osType));
+/* 6 */
+EXTERN Tcl_Obj *	Tcl_NewOSTypeObj _ANSI_ARGS_((OSType osType));
+/* 7 */
+EXTERN int		strncasecmp _ANSI_ARGS_((CONST char *s1,
+				CONST char *s2, size_t n));
+/* 8 */
+EXTERN int		strcasecmp _ANSI_ARGS_((CONST char *s1,
+				CONST char *s2));
+#endif /* MAC_TCL */
 
 typedef struct TclPlatStubs {
     int magic;
-    const struct TclPlatStubHooks *hooks;
+    struct TclPlatStubHooks *hooks;
 
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-    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 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    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 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    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) (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 */
+#ifdef __WIN32__
+    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 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    void (*tcl_MacSetEventProc) _ANSI_ARGS_((Tcl_MacConvertEventPtr procPtr)); /* 0 */
+    char * (*tcl_MacConvertTextResource) _ANSI_ARGS_((Handle resource)); /* 1 */
+    int (*tcl_MacEvalResource) _ANSI_ARGS_((Tcl_Interp *interp, CONST char *resourceName, int resourceNumber, CONST char *fileName)); /* 2 */
+    Handle (*tcl_MacFindResource) _ANSI_ARGS_((Tcl_Interp *interp, long resourceType, CONST char *resourceName, int resourceNumber, CONST char *resFileRef, int *releaseIt)); /* 3 */
+    int (*tcl_GetOSTypeFromObj) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr, OSType *osTypePtr)); /* 4 */
+    void (*tcl_SetOSTypeObj) _ANSI_ARGS_((Tcl_Obj *objPtr, OSType osType)); /* 5 */
+    Tcl_Obj * (*tcl_NewOSTypeObj) _ANSI_ARGS_((OSType osType)); /* 6 */
+    int (*strncasecmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2, size_t n)); /* 7 */
+    int (*strcasecmp) _ANSI_ARGS_((CONST char *s1, CONST char *s2)); /* 8 */
+#endif /* MAC_TCL */
 } TclPlatStubs;
 
 #ifdef __cplusplus
 extern "C" {
 #endif
-extern const TclPlatStubs *tclPlatStubsPtr;
+extern TclPlatStubs *tclPlatStubsPtr;
 #ifdef __cplusplus
 }
 #endif
 
-#if defined(USE_TCL_STUBS)
+#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
 
 /*
  * Inline function declarations:
  */
 
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+#ifndef Tcl_MacOSXOpenBundleResources
 #define Tcl_MacOSXOpenBundleResources \
 	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
+#endif
+#ifndef Tcl_MacOSXOpenVersionedBundleResources
 #define Tcl_MacOSXOpenVersionedBundleResources \
 	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
+#endif
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#ifdef __WIN32__
+#ifndef Tcl_WinUtfToTChar
 #define Tcl_WinUtfToTChar \
 	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
+#endif
+#ifndef Tcl_WinTCharToUtf
 #define Tcl_WinTCharToUtf \
 	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#define Tcl_MacOSXOpenBundleResources \
-	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
-#define Tcl_MacOSXOpenVersionedBundleResources \
-	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
-#endif /* MACOSX */
+#endif
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+#ifndef Tcl_MacSetEventProc
+#define Tcl_MacSetEventProc \
+	(tclPlatStubsPtr->tcl_MacSetEventProc) /* 0 */
+#endif
+#ifndef Tcl_MacConvertTextResource
+#define Tcl_MacConvertTextResource \
+	(tclPlatStubsPtr->tcl_MacConvertTextResource) /* 1 */
+#endif
+#ifndef Tcl_MacEvalResource
+#define Tcl_MacEvalResource \
+	(tclPlatStubsPtr->tcl_MacEvalResource) /* 2 */
+#endif
+#ifndef Tcl_MacFindResource
+#define Tcl_MacFindResource \
+	(tclPlatStubsPtr->tcl_MacFindResource) /* 3 */
+#endif
+#ifndef Tcl_GetOSTypeFromObj
+#define Tcl_GetOSTypeFromObj \
+	(tclPlatStubsPtr->tcl_GetOSTypeFromObj) /* 4 */
+#endif
+#ifndef Tcl_SetOSTypeObj
+#define Tcl_SetOSTypeObj \
+	(tclPlatStubsPtr->tcl_SetOSTypeObj) /* 5 */
+#endif
+#ifndef Tcl_NewOSTypeObj
+#define Tcl_NewOSTypeObj \
+	(tclPlatStubsPtr->tcl_NewOSTypeObj) /* 6 */
+#endif
+#ifndef strncasecmp
+#define strncasecmp \
+	(tclPlatStubsPtr->strncasecmp) /* 7 */
+#endif
+#ifndef strcasecmp
+#define strcasecmp \
+	(tclPlatStubsPtr->strcasecmp) /* 8 */
+#endif
+#endif /* MAC_TCL */
 
-#endif /* defined(USE_TCL_STUBS) */
+#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 /* _TCLPLATDECLS */
 
 
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 7021b8d..f4fb831 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -14,15 +14,16 @@
 #ifndef _TCLPORT
 #define _TCLPORT
 
-#ifdef HAVE_TCL_CONFIG_H
-#include "tclConfig.h"
-#endif
-#if defined(_WIN32)
-#   include "tclWinPort.h"
-#endif
 #include "tcl.h"
-#if !defined(_WIN32)
-#   include "tclUnixPort.h"
+
+#if defined(__WIN32__)
+#   include "tclWinPort.h"
+#else
+#   if defined(MAC_TCL)
+#      include "tclMacPort.h"
+#   else
+#      include "tclUnixPort.h"
+#   endif
 #endif
 
 #if !defined(LLONG_MIN)
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index 411eb27..258996f 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -1,8 +1,9 @@
-/*
+/* 
  * 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.
@@ -12,6 +13,7 @@
  */
 
 #include "tclInt.h"
+#include "tclPort.h"
 
 /*
  *----------------------------------------------------------------------
@@ -21,9 +23,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.
@@ -31,438 +33,426 @@
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_ErrnoId(void)
+CONST char *
+Tcl_ErrnoId()
 {
     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";
-#endif
-#ifdef ECANCELED
-    case ECANCELED: return "ECANCELED";
+	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
-#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
-    case ELIBMAX: return "ELIBMAX";
+#ifdef 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
-#ifdef ENOLINK
-    case ENOLINK: return "ENOLINK";
+#if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != 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
-#ifdef ENOPROTOOPT
-    case ENOPROTOOPT: return "ENOPROTOOPT";
+#if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != 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";
-#endif
-#ifdef ENOTRECOVERABLE
-    case ENOTRECOVERABLE: return "ENOTRECOVERABLE";
+	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";
-#endif
-#ifdef EOTHER
-    case EOTHER: return "EOTHER";
+	case EOPNOTSUPP: return "EOPNOTSUPP";
 #endif
 #if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
-    case EOVERFLOW: return "EOVERFLOW";
-#endif
-#ifdef EOWNERDEAD
-    case EOWNERDEAD: return "EOWNERDEAD";
+        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";
@@ -473,15 +463,17 @@ Tcl_ErrnoId(void)
  *
  * 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.
@@ -489,446 +481,434 @@ Tcl_ErrnoId(void)
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_ErrnoMsg(
-     int err)			/* Error number (such as in errno variable). */
+CONST char *
+Tcl_ErrnoMsg(err)
+    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 "cannot 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";
+	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";
-#endif
-#ifdef ECANCELED
-    case ECANCELED: return "operation canceled";
+	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 "cannot 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 "cannot exec a shared library directly";
+	case ELIBEXEC: return "can not exec a shared library directly";
 #endif
-#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
-    case ELIBMAX: return
-	    "attempting to link in more shared libraries than system limit";
+#ifdef ELIBMAX
+	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
-#ifdef ENOLINK
-    case ENOLINK: return "link has been severed";
+#if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != ENOLINK))
+	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
-#ifdef ENOPROTOOPT
-    case ENOPROTOOPT: return "bad protocol option";
+#if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != ENOPROTOOPT))
+	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";
-#endif
-#ifdef ENOTRECOVERABLE
-    case ENOTRECOVERABLE: return "state not recoverable";
+	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";
-#endif
-#ifdef EOTHER
-    case EOTHER: return "other error";
+	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";
-#endif
-#ifdef EOWNERDEAD
-    case EOWNERDEAD: return "owner died";
+        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 "cannot 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: cannot 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
     }
 }
@@ -941,9 +921,9 @@ Tcl_ErrnoMsg(
  *	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.
@@ -951,118 +931,115 @@ Tcl_ErrnoMsg(
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_SignalId(
-     int sig)			/* Number of signal. */
+CONST char *
+Tcl_SignalId(sig)
+    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";
-#endif
-#if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR))
-    case SIGINFO: return "SIGINFO";
+	case SIGXFSZ: return "SIGXFSZ";
 #endif
     }
     return "unknown signal";
@@ -1076,8 +1053,9 @@ Tcl_SignalId(
  *	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.
@@ -1085,127 +1063,116 @@ Tcl_SignalId(
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_SignalMsg(
-     int sig)			/* Number of signal. */
+CONST char *
+Tcl_SignalMsg(sig)
+    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";
-#endif
-#if defined(SIGINFO) && (!defined(SIGPWR) || (SIGINFO != SIGPWR))
-    case SIGINFO: return "information request";
+	case SIGXFSZ: return "exceeded file size limit";
 #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 0bd8f93..006c92b 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -1,71 +1,69 @@
-/*
+/* 
  * tclPreserve.c --
  *
- *	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.
+ *	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.
  *
  * 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;	/* Function to call to free. */
+				 * effect, so the structure must be freed
+				 * when refCount becomes zero. */
+    Tcl_FreeProc *freeProc;	/* Procedure to call to free. */
 } Reference;
 
-/*
- * 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. */
+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
 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 above pointer used to
+    VOID *ptr2;			/* Backup copy of the abpve 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;
+
+
 
 /*
  *----------------------------------------------------------------------
@@ -85,14 +83,14 @@ typedef struct HandleStruct {
 
 	/* ARGSUSED */
 void
-TclFinalizePreserve(void)
+TclFinalizePreserve()
 {
     Tcl_MutexLock(&preserveMutex);
     if (spaceAvl != 0) {
-	ckfree(refArray);
-	refArray = NULL;
-	inUse = 0;
-	spaceAvl = 0;
+        ckfree((char *) refArray);
+        refArray = (Reference *) NULL;
+        inUse = 0;
+        spaceAvl = 0;
     }
     Tcl_MutexUnlock(&preserveMutex);
 }
@@ -102,34 +100,34 @@ TclFinalizePreserve(void)
  *
  * Tcl_Preserve --
  *
- *	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.
+ *	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.
  *
  * 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)	/* Pointer to malloc'ed block of memory. */
+Tcl_Preserve(clientData)
+    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);
@@ -138,13 +136,26 @@ Tcl_Preserve(
     }
 
     /*
-     * 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) {
-	spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
-	refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference));
+	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;
+	}
     }
 
     /*
@@ -165,79 +176,71 @@ Tcl_Preserve(
  *
  * Tcl_Release --
  *
- *	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).
+ *	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).
  *
  * 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)	/* Pointer to malloc'ed block of memory. */
+Tcl_Release(clientData)
+    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++) {
-	int mustFree;
-	Tcl_FreeProc *freeProc;
-
+    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
 	if (refPtr->clientData != clientData) {
 	    continue;
 	}
-
-	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(clientData);
-	    } else {
-		freeProc(clientData);
+	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;
+		}
 	    }
 	}
+	Tcl_MutexUnlock(&preserveMutex);
 	return;
     }
     Tcl_MutexUnlock(&preserveMutex);
 
     /*
-     * Reference not found. This is a bug in the caller.
+     * Reference not found.  This is a bug in the caller.
      */
 
-    Tcl_Panic("Tcl_Release couldn't find reference for %p", clientData);
+    panic("Tcl_Release couldn't find reference for 0x%x", clientData);
 }
 
 /*
@@ -245,9 +248,10 @@ Tcl_Release(
  *
  * 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.
@@ -259,16 +263,16 @@ Tcl_Release(
  */
 
 void
-Tcl_EventuallyFree(
-    ClientData clientData,	/* Pointer to malloc'ed block of memory. */
-    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
+Tcl_EventuallyFree(clientData, freeProc)
+    ClientData clientData;	/* Pointer to malloc'ed block of memory. */
+    Tcl_FreeProc *freeProc;	/* Procedure 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);
@@ -277,12 +281,12 @@ Tcl_EventuallyFree(
 	    continue;
 	}
 	if (refPtr->mustFree) {
-	    Tcl_Panic("Tcl_EventuallyFree called twice for %p", clientData);
-	}
-	refPtr->mustFree = 1;
+	    panic("Tcl_EventuallyFree called twice for 0x%x\n", clientData);
+        }
+        refPtr->mustFree = 1;
 	refPtr->freeProc = freeProc;
 	Tcl_MutexUnlock(&preserveMutex);
-	return;
+        return;
     }
     Tcl_MutexUnlock(&preserveMutex);
 
@@ -291,9 +295,9 @@ Tcl_EventuallyFree(
      */
 
     if (freeProc == TCL_DYNAMIC) {
-	ckfree(clientData);
+	ckfree((char *) clientData);
     } else {
-	freeProc(clientData);
+	(*freeProc)((char *)clientData);
     }
 }
 
@@ -302,33 +306,36 @@ Tcl_EventuallyFree(
  *
  * 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(
-    void *ptr)			/* Pointer to an arbitrary block of memory to
-				 * be tracked for deletion. Must not be
+TclHandleCreate(ptr)
+    VOID *ptr;			/* Pointer to an arbitrary block of memory
+				 * to be tracked for deletion.  Must not be
 				 * NULL. */
 {
-    HandleStruct *handlePtr = ckalloc(sizeof(HandleStruct));
+    HandleStruct *handlePtr;
 
+    handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
     handlePtr->ptr = ptr;
 #ifdef TCL_MEM_DEBUG
     handlePtr->ptr2 = ptr;
@@ -342,10 +349,11 @@ TclHandleCreate(
  *
  * 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.
@@ -357,27 +365,27 @@ TclHandleCreate(
  */
 
 void
-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. */
+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. */
 {
     HandleStruct *handlePtr;
 
     handlePtr = (HandleStruct *) handle;
 #ifdef TCL_MEM_DEBUG
     if (handlePtr->refCount == 0x61616161) {
-	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
+	panic("using previously disposed TclHandle %x", handlePtr);
     }
     if (handlePtr->ptr2 != handlePtr->ptr) {
-	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
+	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
     handlePtr->ptr = NULL;
     if (handlePtr->refCount == 0) {
-	ckfree(handlePtr);
+	ckfree((char *) handlePtr);
     }
 }
 
@@ -386,35 +394,36 @@ TclHandleFree(
  *
  * 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(
-    TclHandle handle)		/* Declare an interest in the block of memory
-				 * referenced by this handle. */
+TclHandlePreserve(handle)
+    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) {
-	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
+	panic("using previously disposed TclHandle %x", handlePtr);
     }
-    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
-	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
+    if ((handlePtr->ptr != NULL)
+	    && (handlePtr->ptr != handlePtr->ptr2)) {
+	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
@@ -428,47 +437,41 @@ TclHandlePreserve(
  *
  * TclHandleRelease --
  *
- *	This function is called to release an interest in the malloc'd block
- *	associated with the handle.
+ *	This procedure 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(
-    TclHandle handle)		/* Unregister interest in the block of memory
-				 * referenced by this handle. */
+TclHandleRelease(handle)
+    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) {
-	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
+	panic("using previously disposed TclHandle %x", handlePtr);
     }
-    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
-	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
+    if ((handlePtr->ptr != NULL)
+	    && (handlePtr->ptr != handlePtr->ptr2)) {
+	panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
 		handlePtr, handlePtr->ptr2, handlePtr->ptr);
     }
 #endif
     handlePtr->refCount--;
     if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
-	ckfree(handlePtr);
+	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 d008217..abfd152 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1,106 +1,48 @@
 /*
  * 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"
 #include "tclCompile.h"
-#include "tclOOInt.h"
-
-/*
- * Variables that are part of the [apply] command implementation and which
- * have to be passed to the other side of the NRE call.
- */
-
-typedef struct {
-    int isRootEnsemble;
-    Command cmd;
-    ExtraFrameInfo efi;
-} ApplyExtraData;
 
 /*
  * Prototypes for static functions in this file
  */
 
-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 Tcl_NRPostProc ApplyNR2;
-static Tcl_NRPostProc InterpProcNR2;
-static Tcl_NRPostProc Uplevel_Callback;
+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));
 
 /*
  * The ProcBodyObjType type
  */
 
-const Tcl_ObjType tclProcBodyType = {
+Tcl_ObjType tclProcBodyType = {
     "procbody",			/* name for this type */
-    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 ptrAndLongRep field,
- * encoding the type of level reference in ptr and the actual parsed out
- * offset in value.
- *
- * Uses the default behaviour throughout, and never disposes of the string
- * rep; it's just a cache type.
- */
-
-static const 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 const Tcl_ObjType lambdaType = {
-    "lambdaExpr",		/* name */
-    FreeLambdaInternalRep,	/* freeIntRepProc */
-    DupLambdaInternalRep,	/* dupIntRepProc */
-    NULL,			/* updateStringProc */
-    SetLambdaFromAny		/* setFromAnyProc */
+    ProcBodyFree,		/* FreeInternalRep procedure */
+    ProcBodyDup,		/* DupInternalRep procedure */
+    ProcBodyUpdateString,	/* UpdateString procedure */
+    ProcBodySetFromAny		/* SetFromAny procedure */
 };
 
 /*
@@ -108,7 +50,7 @@ static const Tcl_ObjType lambdaType = {
  *
  * Tcl_ProcObjCmd --
  *
- *	This object-based function is invoked to process the "proc" Tcl
+ *	This object-based procedure is invoked to process the "proc" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -122,16 +64,16 @@ static const Tcl_ObjType lambdaType = {
 
 	/* ARGSUSED */
 int
-Tcl_ProcObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     register Interp *iPtr = (Interp *) interp;
     Proc *procPtr;
-    const char *fullName;
-    const char *procName, *procArgs, *procBody;
+    char *fullName;
+    CONST char *procName, *procArgs, *procBody;
     Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
     Tcl_Command cmd;
     Tcl_DString ds;
@@ -142,51 +84,47 @@ Tcl_ProcObjCmd(
     }
 
     /*
-     * 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, NULL, 0,
-	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+    TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
+	    0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
 
     if (nsPtr == NULL) {
-	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
-		"\": unknown namespace", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", fullName,
+		"\": unknown namespace", (char *) NULL);
+        return TCL_ERROR;
     }
     if (procName == NULL) {
-	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
-		"\": bad procedure name", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
-	return TCL_ERROR;
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", fullName,
+		"\": bad procedure name", (char *) NULL);
+        return TCL_ERROR;
     }
     if ((nsPtr != iPtr->globalNsPtr)
 	    && (procName != NULL) && (procName[0] == ':')) {
-	Tcl_AppendResult(interp, "can't create procedure \"", procName,
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"can't create procedure \"", procName,
 		"\" in non-global namespace with name starting with \":\"",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
-	return TCL_ERROR;
+	        (char *) 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) {
-	Tcl_AddErrorInfo(interp, "\n    (creating proc \"");
-	Tcl_AddErrorInfo(interp, procName);
-	Tcl_AddErrorInfo(interp, "\")");
-	return TCL_ERROR;
+        &procPtr) != TCL_OK) {
+        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.
      */
@@ -198,10 +136,12 @@ Tcl_ProcObjCmd(
     }
     Tcl_DStringAppend(&ds, procName, -1);
 
-    cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
-	    TclNRInterpProc, procPtr, TclProcDeleteProc);
-    Tcl_DStringFree(&ds);
+    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
@@ -211,132 +151,113 @@ Tcl_ProcObjCmd(
 
     procPtr->cmdPtr = (Command *) cmd;
 
-    /*
-     * 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
+#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
      * 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 *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
+        CmdFrame context = *iPtr->cmdFramePtr;
 
-	*contextPtr = *iPtr->cmdFramePtr;
-	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.
-	     */
+	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);
+	}
 
-	    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.
-	     */
+	/* 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.
+	 */
 
-	    Tcl_IncrRefCount(contextPtr->data.eval.path);
-	}
+	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_SOURCE) {
-	    /*
-	     * We can account for source location within a proc only if the
-	     * proc body was not created by substitution.
-	     */
+	    cfPtr->cmd.str.cmd = NULL;
+	    cfPtr->cmd.str.len = 0;
 
-	    if (contextPtr->line
-		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
-		int isNew;
-		Tcl_HashEntry *hePtr;
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-
-		cfPtr->level = -1;
-		cfPtr->type = contextPtr->type;
-		cfPtr->line = 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,
-			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.
-		     */
+	    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 = 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;
-		    }
-		    ckfree(cfOldPtr->line);
-		    cfOldPtr->line = NULL;
-		    ckfree(cfOldPtr);
+		if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
+		    Tcl_DecrRefCount(cfOldPtr->data.eval.path);
+		    cfOldPtr->data.eval.path = NULL;
 		}
-		Tcl_SetHashValue(hePtr, cfPtr);
+		ckfree((char *) cfOldPtr->line);
+		cfOldPtr->line = NULL;
+		ckfree((char *) cfOldPtr);
 	    }
-
-	    /*
-	     * '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;
+	    Tcl_SetHashValue (hePtr, cfPtr);
 	}
-	TclStackFree(interp, contextPtr);
     }
+#endif
 
     /*
-     * Optimize for no-op procs: if the body is not precompiled (like a TclPro
+     * Optimize for noop 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 no-op.
+     * define a compileProc to compile a noop.
      *
      * 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 = TclGetString(objv[2]);
+    procArgs = Tcl_GetString(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;
 	    }
@@ -347,9 +268,12 @@ Tcl_ProcObjCmd(
 	 * The argument list is just "args"; check the body
 	 */
 
-	procBody = Tcl_GetStringFromObj(objv[3], &numBytes);
-	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
-	    goto done;
+	procBody = Tcl_GetString(objv[3]);
+	while (*procBody != '\0') {
+	    if (!isspace(UCHAR(*procBody))) {
+		goto done;
+	    }
+	    procBody++;
 	}
 
 	/*
@@ -359,7 +283,7 @@ Tcl_ProcObjCmd(
 	((Command *) cmd)->compileProc = TclCompileNoOp;
     }
 
-  done:
+ done:
     return TCL_OK;
 }
 
@@ -368,204 +292,207 @@ Tcl_ProcObjCmd(
  *
  * TclCreateProc --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	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.
+ *	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.
  *
  * Side effects:
- *	If anything goes wrong, this function returns an error message in the
- *	interpreter.
+ *	If anything goes wrong, this procedure returns an error
+ *	message in the interpreter.
  *
  *----------------------------------------------------------------------
  */
-
 int
-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. */
+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 */
 {
-    Interp *iPtr = (Interp *) interp;
-    const char **argArray = NULL;
+    Interp *iPtr = (Interp*)interp;
+    CONST char **argArray = NULL;
 
     register Proc *procPtr;
     int i, length, result, numArgs;
-    const char *args, *bytes, *p;
+    CONST char *args, *bytes, *p;
     register CompiledLocal *localPtr = NULL;
     Tcl_Obj *defPtr;
     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. 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.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. 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;
     } 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 "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;
-
-	    bytes = TclGetStringFromObj(bodyPtr, &length);
-	    bodyPtr = Tcl_NewStringObj(bytes, length);
-
+        /*
+         * 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
+	    Tcl_Obj* sharedBodyPtr = bodyPtr;
+#endif
+            bytes = Tcl_GetStringFromObj(bodyPtr, &length);
+            bodyPtr = Tcl_NewStringObj(bytes, length);
+#ifdef TCL_TIP280
 	    /*
 	     * TIP #280.
 	     * Ensure that the continuation line data for the original body is
 	     * not lost and applies to the new body as well.
 	     */
 
-	    TclContinuationsCopy(bodyPtr, sharedBodyPtr);
-	}
+	    TclContinuationsCopy (bodyPtr, sharedBodyPtr);
+#endif
+        }
 
-	/*
-	 * 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.
-	 */
+        /*
+         * 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.
+         */
 
-	Tcl_IncrRefCount(bodyPtr);
+        Tcl_IncrRefCount(bodyPtr);
 
-	procPtr = 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 parsed argument is consistent with the one stored
-     * in the Proc.
-     *
-     * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
+     * 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.
      */
 
-    args = TclGetStringFromObj(argsPtr, &length);
+    args = Tcl_GetStringFromObj(argsPtr, &length);
     result = Tcl_SplitList(interp, args, &numArgs, &argArray);
     if (result != TCL_OK) {
-	goto procError;
+        goto procError;
     }
 
     if (precompiled) {
-	if (numArgs > procPtr->numArgs) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "procedure \"%s\": arg list contains %d entries, "
-		    "precompiled header expects %d", procName, numArgs,
-		    procPtr->numArgs));
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-		    "BYTECODELIES", NULL);
-	    goto procError;
-	}
-	localPtr = procPtr->firstLocalPtr;
+        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;
     } 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(fieldValues);
-	    Tcl_AppendResult(interp,
-		    "too many fields in argument specifier \"",
-		    argArray[i], "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-		    "FORMALARGUMENTFORMAT", NULL);
-	    goto procError;
-	}
-	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
-	    ckfree(fieldValues);
-	    Tcl_AppendResult(interp, "argument with no name", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-		    "FORMALARGUMENTFORMAT", 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_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 {
 		    q++;
 		} while (*q != '\0');
 		q--;
-		if (*q == ')') {	/* We have an array element. */
-		    Tcl_AppendResult(interp, "formal parameter \"",
-			    fieldValues[0], "\" is an array element", NULL);
-		    ckfree(fieldValues);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			    "FORMALARGUMENTFORMAT", NULL);
+		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);
+		    ckfree((char *) fieldValues);
 		    goto procError;
 		}
 	    } else if ((*p == ':') && (*(p+1) == ':')) {
-		Tcl_AppendResult(interp, "formal parameter \"",
-			fieldValues[0], "\" is not a simple name", NULL);
-		ckfree(fieldValues);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			"FORMALARGUMENTFORMAT", NULL);
+		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		        "procedure \"", procName,
+		        "\" has formal parameter \"", fieldValues[0],
+			"\" that is not a simple name",
+			(char *) NULL);
+		ckfree((char *) fieldValues);
 		goto procError;
 	    }
 	    p++;
@@ -573,122 +500,119 @@ TclCreateProc(
 
 	if (precompiled) {
 	    /*
-	     * 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.
+	     * 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
 	     */
 
 	    if ((localPtr->nameLength != nameLength)
 		    || (strcmp(localPtr->name, fieldValues[0]))
 		    || (localPtr->frameIndex != i)
-		    || !(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(fieldValues);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			"BYTECODELIES", NULL);
+		    || ((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);
+		ckfree((char *) fieldValues);
 		goto procError;
 	    }
 
-	    /*
-	     * Compare the default value if any.
-	     */
-
-	    if (localPtr->defValuePtr != NULL) {
-		int tmpLength;
-		const 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(fieldValues);
-		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			    "BYTECODELIES", NULL);
-		    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 = ckalloc(TclOffset(CompiledLocal, 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(fieldValues);
+            /*
+             * 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);
+	}
+
+        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(argArray);
+    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(localPtr);
-	}
-	ckfree(procPtr);
+            ckfree((char *) localPtr);
+        }
+        ckfree((char *) procPtr);
     }
     if (argArray != NULL) {
-	ckfree(argArray);
+	ckfree((char *) argArray);
     }
     return TCL_ERROR;
 }
@@ -698,19 +622,19 @@ TclCreateProc(
  *
  * 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.
@@ -719,11 +643,11 @@ TclCreateProc(
  */
 
 int
-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). */
+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). */
 {
     register Interp *iPtr = (Interp *) interp;
     int curLevel, level, result;
@@ -734,176 +658,47 @@ TclGetFrame(
      */
 
     result = 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);
-    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", 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;
-
-    /*
-     * Parse object to figure out which level number to go to.
-     */
-
-    result = 1;
-    curLevel = iPtr->varFramePtr->level;
-    if (objPtr == NULL) {
-	name = "1";
-	goto haveLevel1;
-    }
-
-    name = TclGetString(objPtr);
-    if (objPtr->typePtr == &levelReferenceType) {
-	if (objPtr->internalRep.ptrAndLongRep.ptr != NULL) {
-	    level = curLevel - objPtr->internalRep.ptrAndLongRep.value;
-	} else {
-	    level = objPtr->internalRep.ptrAndLongRep.value;
+    curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
+    if (*string == '#') {
+	if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
+	    return -1;
 	}
 	if (level < 0) {
-	    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;
+	    levelError:
+	    Tcl_AppendResult(interp, "bad level \"", string, "\"",
+		    (char *) NULL);
+	    return -1;
 	}
-
-	/*
-	 * Cache for future reference.
-	 *
-	 * TODO: Use the new ptrAndLongRep intrep
-	 */
-
-	TclFreeIntRep(objPtr);
-	objPtr->typePtr = &levelReferenceType;
-	objPtr->internalRep.ptrAndLongRep.ptr = NULL;
-	objPtr->internalRep.ptrAndLongRep.value = level;
-    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
-	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
+    } else if (isdigit(UCHAR(*string))) { /* INTL: digit */
+	if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
 	    return -1;
 	}
-
-	/*
-	 * Cache for future reference.
-	 *
-	 * TODO: Use the new ptrAndLongRep intrep
-	 */
-
-	TclFreeIntRep(objPtr);
-	objPtr->typePtr = &levelReferenceType;
-	objPtr->internalRep.ptrAndLongRep.ptr = (void *) 1; /* non-NULL */
-	objPtr->internalRep.ptrAndLongRep.value = level;
 	level = curLevel - level;
     } else {
-	/*
-	 * Don't cache as the object *isn't* a level reference (might even be
-	 * NULL...)
-	 */
-
-    haveLevel1:
 	level = curLevel - 1;
 	result = 0;
     }
 
     /*
-     * Figure out which frame to use, and return it to the caller.
+     * Figure out which frame to use, and modify the interpreter so
+     * its variables come from that frame.
      */
 
-    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
-	    framePtr = framePtr->callerVarPtr) {
-	if (framePtr->level == level) {
-	    break;
+    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;
 	}
-    }
-    if (framePtr == NULL) {
-	goto levelError;
     }
     *framePtrPtr = framePtr;
     return result;
-
-  levelError:
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
-    return -1;
 }
 
 /*
@@ -911,8 +706,8 @@ TclObjGetFrame(
  *
  * Tcl_UplevelObjCmd --
  *
- *	This object function is invoked to process the "uplevel" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This object procedure 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.
@@ -923,55 +718,21 @@ TclObjGetFrame(
  *----------------------------------------------------------------------
  */
 
-static int
-Uplevel_Callback(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    CallFrame *savedVarFramePtr = data[0];
-
-    if (result == TCL_ERROR) {
-	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-		"\n    (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp)));
-    }
-
-    /*
-     * Restore the variable frame, and return.
-     */
-
-    ((Interp *)interp)->varFramePtr = savedVarFramePtr;
-    return result;
-}
-
 	/* ARGSUSED */
 int
-Tcl_UplevelObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRUplevelObjCmd(
-    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;
-    CmdFrame *invoker = NULL;
-    int word = 0;
+    char *optLevel;
     int result;
     CallFrame *savedVarFramePtr, *framePtr;
-    Tcl_Obj *objPtr;
 
     if (objc < 2) {
-    uplevelSyntax:
+	uplevelSyntax:
 	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
 	return TCL_ERROR;
     }
@@ -980,15 +741,16 @@ TclNRUplevelObjCmd(
      * Find the level to use for executing the command.
      */
 
-    result = TclObjGetFrame(interp, objv[1], &framePtr);
+    optLevel = TclGetString(objv[1]);
+    result = TclGetFrame(interp, optLevel, &framePtr);
     if (result == -1) {
 	return TCL_ERROR;
     }
-    objc -= result + 1;
+    objc -= (result+1);
     if (objc == 0) {
 	goto uplevelSyntax;
     }
-    objv += result + 1;
+    objv += (result+1);
 
     /*
      * Modify the interpreter state to execute in the given frame.
@@ -1002,26 +764,38 @@ TclNRUplevelObjCmd(
      */
 
     if (objc == 1) {
-	/*
-	 * TIP #280. Make actual argument location available to eval'd script
-	 */
-
-	TclArgumentGet(interp, objv[0], &invoker, &word);
-	objPtr = objv[0];
-
+#ifdef TCL_TIP280
+	/* 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
     } 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);
     }
 
-    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
-	    NULL);
-    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
+    /*
+     * Restore the variable frame, and return.
+     */
+
+    iPtr->varFramePtr = savedVarFramePtr;
+    return result;
 }
 
 /*
@@ -1029,17 +803,18 @@ TclNRUplevelObjCmd(
  *
  * 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.
@@ -1048,20 +823,29 @@ TclNRUplevelObjCmd(
  */
 
 Proc *
-TclFindProc(
-    Interp *iPtr,		/* Interpreter in which to look. */
-    const char *procName)	/* Name of desired procedure. */
+TclFindProc(iPtr, procName)
+    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, NULL, /*flags*/ 0);
+    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
+            (Tcl_Namespace *) NULL, /*flags*/ 0);
     if (cmd == (Tcl_Command) NULL) {
-	return NULL;
+        return NULL;
     }
     cmdPtr = (Command *) cmd;
 
-    return TclIsProc(cmdPtr);
+    origCmd = TclGetOriginalCommand(cmd);
+    if (origCmd != NULL) {
+	cmdPtr = (Command *) origCmd;
+    }
+    if (cmdPtr->proc != TclProcInterpProc) {
+	return NULL;
+    }
+    return (Proc *) cmdPtr->clientData;
 }
 
 /*
@@ -1072,9 +856,9 @@ TclFindProc(
  *	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.
@@ -1083,701 +867,328 @@ TclFindProc(
  */
 
 Proc *
-TclIsProc(
-    Command *cmdPtr)		/* Command to test. */
+TclIsProc(cmdPtr)
+    Command *cmdPtr;		/* Command to test. */
 {
-    Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
+    Tcl_Command origCmd;
 
+    origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
     if (origCmd != NULL) {
 	cmdPtr = (Command *) origCmd;
     }
-    if (cmdPtr->deleteProc == TclProcDeleteProc) {
-	return cmdPtr->objClientData;
+    if (cmdPtr->proc == TclProcInterpProc) {
+	return (Proc *) cmdPtr->clientData;
     }
-    return NULL;
-}
-
-static int
-ProcWrongNumArgs(
-    Tcl_Interp *interp,
-    int skip)
-{
-    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;
-
-    /*
-     * Build up desired argument list for Tcl_WrongNumArgs
-     */
-
-    numArgs = framePtr->procPtr->numArgs;
-    desiredObjs = TclStackAlloc(interp,
-	    (int) sizeof(Tcl_Obj *) * (numArgs+1));
-
-    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
-	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
-    } else {
-	((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;
-
-#ifdef AVOID_HACKS_FOR_ITCL
-	desiredObjs[0] = framePtr->objv[skip-1];
-#else
-	desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
-#endif /* AVOID_HACKS_FOR_ITCL */
-    }
-    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 = "?arg ...?";
-	    break;
-	} else {
-	    argObj = namePtr;
-	    Tcl_IncrRefCount(namePtr);
-	}
-	desiredObjs[i] = argObj;
-    }
-
-    Tcl_ResetResult(interp);
-    Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);
-
-    for (i=0 ; i<=numArgs ; i++) {
-	Tcl_DecrRefCount(desiredObjs[i]);
-    }
-    TclStackFree(interp, desiredObjs);
-    return TCL_ERROR;
+    return (Proc *) 0;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclInitCompiledLocals --
- *
- *	This routine is invoked in order to initialize the compiled locals
- *	table for a new call frame.
+ * TclProcInterpProc --
  *
- *	DEPRECATED: functionality has been inlined elsewhere; this function
- *	remains to insure binary compatibility with Itcl.
+ *	When a Tcl procedure gets invoked with an argc/argv array of
+ *	strings, this routine gets invoked to interpret the procedure.
  *
  * Results:
- *	None.
+ *	A standard Tcl result value, usually TCL_OK.
  *
  * Side effects:
- *	May invoke various name resolvers in order to determine which
- *	variables are being referenced at runtime.
+ *	Depends on the commands in the procedure.
  *
  *----------------------------------------------------------------------
  */
 
-void
-TclInitCompiledLocals(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    CallFrame *framePtr,	/* Call frame to initialize. */
-    Namespace *nsPtr)		/* Pointer to current namespace. */
+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. */
 {
-    Var *varPtr = framePtr->compiledLocals;
-    Tcl_Obj *bodyPtr;
-    ByteCode *codePtr;
-
-    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.otherValuePtr;
-
-    if (framePtr->numCompiledLocals) {
-	if (!codePtr->localCachePtr) {
-	    InitLocalCache(framePtr->procPtr) ;
-	}
-	framePtr->localCachePtr = codePtr->localCachePtr;
-	framePtr->localCachePtr->refCount++;
-    }
+    register Tcl_Obj *objPtr;
+    register int i;
+    int result;
 
-    InitResolvedLocals(interp, codePtr, varPtr, nsPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * InitResolvedLocals --
- *
- *	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.
- *
- *----------------------------------------------------------------------
- */
+    /*
+     * 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.
+     */
 
-static void
-InitResolvedLocals(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    ByteCode *codePtr,
-    Var *varPtr,
-    Namespace *nsPtr)		/* Pointer to current namespace. */
-{
-    Interp *iPtr = (Interp *) interp;
-    int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
-    CompiledLocal *firstLocalPtr, *localPtr;
-    int varNum;
-    Tcl_ResolvedVarInfo *resVarInfo;
+#define NUM_ARGS 20
+    Tcl_Obj *(objStorage[NUM_ARGS]);
+    register Tcl_Obj **objv = objStorage;
 
     /*
-     * Find the localPtr corresponding to varPtr
+     * 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.
      */
 
-    varNum = varPtr - iPtr->framePtr->compiledLocals;
-    localPtr = iPtr->framePtr->procPtr->firstLocalPtr;
-    while (varNum--) {
-	localPtr = localPtr->nextPtr;
+    if ((argc + 1) > NUM_ARGS) {
+	objv = (Tcl_Obj **)
+	    ckalloc((unsigned)(argc + 1) * sizeof(Tcl_Obj *));
     }
 
-    if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
-	goto doInitResolvedLocals;
+    for (i = 0;  i < argc;  i++) {
+	objv[i] = Tcl_NewStringObj(argv[i], -1);
+	Tcl_IncrRefCount(objv[i]);
     }
+    objv[argc] = 0;
 
     /*
-     * This is the first run after a recompile, or else the resolver epoch
-     * has changed: update the resolver cache.
+     * Use TclObjInterpProc to actually interpret the procedure.
      */
 
-    firstLocalPtr = localPtr;
-    for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
-	if (localPtr->resolveInfo) {
-	    if (localPtr->resolveInfo->deleteProc) {
-		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
-	    } else {
-		ckfree(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;
-	    }
-
-	    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;
+    result = TclObjInterpProc(clientData, interp, argc, objv);
 
     /*
-     * 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.
+     * Move the interpreter's object result to the string result,
+     * then reset the object result.
      */
 
-  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) {
-	    register Var *resolvedVarPtr = (Var *)
-		    resVarInfo->fetchProc(interp, resVarInfo);
-
-	    if (resolvedVarPtr) {
-		if (TclIsVarInHash(resolvedVarPtr)) {
-		    VarHashRefCount(resolvedVarPtr)++;
-		}
-		varPtr->flags = VAR_LINK;
-		varPtr->value.linkPtr = resolvedVarPtr;
-	    }
-	}
-    }
-}
-
-void
-TclFreeLocalCache(
-    Tcl_Interp *interp,
-    LocalCache *localCachePtr)
-{
-    int i;
-    Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
-
-    for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
-	register Tcl_Obj *objPtr = *namePtrPtr;
+    Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	    TCL_VOLATILE);
 
-	/*
-	 * 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.
-	 */
+    /*
+     * Decrement the ref counts on the objv elements since we are done
+     * with them.
+     */
 
-	if (objPtr) {
-	    if (interp) {
-		TclReleaseLiteral(interp, objPtr);
-	    } else {
-		Tcl_DecrRefCount(objPtr);
-	    }
-	}
+    for (i = 0;  i < argc;  i++) {
+	objPtr = objv[i];
+	TclDecrRefCount(objPtr);
     }
-    ckfree(localCachePtr);
-}
-
-static void
-InitLocalCache(
-    Proc *procPtr)
-{
-    Interp *iPtr = procPtr->iPtr;
-    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
-    int localCt = procPtr->numCompiledLocals;
-    int numArgs = procPtr->numArgs, i = 0;
-
-    Tcl_Obj **namePtr;
-    Var *varPtr;
-    LocalCache *localCachePtr;
-    CompiledLocal *localPtr;
-    int new;
 
     /*
-     * 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.
+     * Free the objv array if malloc'ed storage was used.
      */
 
-    localCachePtr = ckalloc(sizeof(LocalCache)
-	    + (localCt - 1) * sizeof(Tcl_Obj *)
-	    + numArgs * sizeof(Var));
-
-    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;
+    if (objv != objStorage) {
+	ckfree((char *) objv);
     }
-    codePtr->localCachePtr = localCachePtr;
-    localCachePtr->refCount = 1;
-    localCachePtr->numVars = localCt;
+    return result;
+#undef NUM_ARGS
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * InitArgsAndLocals --
+ * TclObjInterpProc --
  *
- *	This routine is invoked in order to initialize the arguments and other
- *	compiled locals table for a new call frame.
+ *	When a Tcl procedure gets invoked during bytecode evaluation, this
+ *	object-based routine gets invoked to interpret the procedure.
  *
  * Results:
- *	A standard Tcl result.
+ *	A standard Tcl object result value.
  *
  * Side effects:
- *	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.
+ *	Depends on the commands in the procedure.
  *
  *----------------------------------------------------------------------
  */
 
-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". */
+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. */
 {
-    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
-    register Proc *procPtr = framePtr->procPtr;
-    ByteCode *codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
-    register Var *varPtr, *defPtr;
-    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
-    Tcl_Obj *const *argObjs;
+    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;
 
     /*
-     * Make sure that the local cache of variable names and initial values has
-     * been initialised properly .
+     * 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.
      */
 
-    if (localCt) {
-	if (!codePtr->localCachePtr) {
-	    InitLocalCache(procPtr) ;
-	}
-	framePtr->localCachePtr = codePtr->localCachePtr;
-	framePtr->localCachePtr->refCount++;
-	defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
-    } else {
-	defPtr = NULL;
-    }
+#define NUM_LOCALS 20
+    Var localStorage[NUM_LOCALS];
+    Var *compiledLocals = localStorage;
 
     /*
-     * Create the "compiledLocals" array. Make sure it is large enough to hold
-     * all the procedure's compiled local variables, including its formal
-     * parameters.
+     * Get the procedure's name.
      */
 
-    varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var)));
-    framePtr->compiledLocals = varPtr;
-    framePtr->numCompiledLocals = localCt;
+    procName = Tcl_GetStringFromObj(objv[0], &nameLen);
 
     /*
-     * 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.
+     * 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.
      */
 
-    numArgs = procPtr->numArgs;
-    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 ? defPtr++ : defPtr) {
-	/*
-	 * "Normal" arguments; last formal is special, depends on it being
-	 * 'args'.
-	 */
-
-	Tcl_Obj *objPtr = argObjs[i];
+    result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
+	    "body of proc", procName, &procPtr);
 
-	varPtr->flags = 0;
-	varPtr->value.objPtr = objPtr;
-	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-    }
-    for (; i < numArgs-1; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
-	/*
-	 * This loop is entered if argCt < (numArgs-1). Set default values;
-	 * last formal is special.
-	 */
-
-	Tcl_Obj *objPtr = defPtr ? defPtr->value.objPtr : NULL;
-
-	if (!objPtr) {
-	    goto incorrectArgs;
-	}
-	varPtr->flags = 0;
-	varPtr->value.objPtr = objPtr;
-	Tcl_IncrRefCount(objPtr);	/* Local var reference. */
+    if (result != TCL_OK) {
+        return result;
     }
 
     /*
-     * When we get here, the last formal argument remains to be defined:
-     * defPtr and varPtr point to the last argument to be initialized.
+     * Create the "compiledLocals" array. Make sure it is large enough to
+     * hold all the procedure's compiled local variables, including its
+     * formal parameters.
      */
 
-    varPtr->flags = 0;
-    if (defPtr && 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];
-
-	varPtr->value.objPtr = objPtr;
-	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-    } else if ((argCt < numArgs) && defPtr && defPtr->value.objPtr) {
-	Tcl_Obj *objPtr = defPtr->value.objPtr;
-
-	varPtr->value.objPtr = objPtr;
-	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
-    } else {
-	goto incorrectArgs;
+    localCt = procPtr->numCompiledLocals;
+    if (localCt > NUM_LOCALS) {
+	compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
     }
-    varPtr++;
 
     /*
-     * Initialise and resolve the remaining compiledLocals. In the absence of
-     * resolvers, they are undefined local vars: (flags=0, value=NULL).
+     * 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.
      */
 
-  correctArgs:
-    if (numArgs < localCt) {
-	if (!framePtr->nsPtr->compiledVarResProc
-		&& !((Interp *)interp)->resolverPtr) {
-	    memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
-	} else {
-	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
-	}
+    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+            (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 1);
+
+    if (result != TCL_OK) {
+        return result;
     }
 
-    return TCL_OK;
+    framePtr->objc = objc;
+    framePtr->objv = objv;  /* ref counts for args are incremented below */
 
     /*
-     * Initialise all compiled locals to avoid problems at DeleteLocalVars.
+     * Initialize and resolve compiled variable references.
      */
 
-  incorrectArgs:
-    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.
- *
- *----------------------------------------------------------------------
- */
+    framePtr->procPtr = procPtr;
+    framePtr->numCompiledLocals = localCt;
+    framePtr->compiledLocals = compiledLocals;
 
-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 = clientData;
-    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
-    CallFrame *framePtr, **framePtrPtr;
-    int result;
-    ByteCode *codePtr;
+    TclInitCompiledLocals(interp, framePtr, nsPtr);
 
     /*
-     * 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.
+     * 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.
      */
 
-    if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
-	Interp *iPtr = (Interp *) interp;
+    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;
+	}
 
 	/*
-	 * 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).
+	 * Handle the special case of the last formal being "args".  When
+	 * it occurs, assign it a list consisting of all the remaining
+	 * actual arguments.
 	 */
 
-	codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
-	if (((Interp *) *codePtr->interpHandle != iPtr)
-		|| (codePtr->compileEpoch != iPtr->compileEpoch)
-		|| (codePtr->nsPtr != nsPtr)
-		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
-	    goto doCompilation;
-	}
-    } else {
-    doCompilation:
-	result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
-		(isLambda ? "body of lambda term" : "body of proc"),
-		TclGetString(objv[isLambda]));
-	if (result != TCL_OK) {
-	    return result;
+	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;
+	    varPtr->value.objPtr = objPtr;
+	    TclClearVarUndefined(varPtr);
+	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
+					* another reference to object. */
+	} else {
+	    goto incorrectArgs;
 	}
+	varPtr++;
+	localPtr = localPtr->nextPtr;
     }
+    if (argCt > 0) {
+	Tcl_Obj *objResult;
+	int len, flags;
 
-    /*
-     * 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.
-     */
-
-    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;
+	incorrectArgs:
+	/*
+	 * Build up equivalent to Tcl_WrongNumArgs message for proc
+	 */
 
-    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.
- *
- *----------------------------------------------------------------------
- */
+	Tcl_ResetResult(interp);
+	objResult = Tcl_GetObjResult(interp);
+	Tcl_AppendToObj(objResult, "wrong # args: should be \"", -1);
 
-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. */
-{
-    /*
-     * Not used much in the core; external interface for iTcl
-     */
+	/*
+	 * Quote the proc name if it contains spaces (Bug 942757).
+	 */
 
-    return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
-}
+	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);
+	} else {
+	    Tcl_AppendToObj(objResult, procName, len);
+	}
 
-int
-TclNRInterpProc(
-    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 = PushProcCallFrame(clientData, interp, objc, objv,
-	    /*isLambda*/ 0);
+	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);
 
-    if (result != TCL_OK) {
-	return TCL_ERROR;
+	result = TCL_ERROR;
+	goto procDone;
     }
-    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclNRInterpProcCore --
- *
- *	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
-TclNRInterpProcCore(
-    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;
-    ByteCode *codePtr;
-
-    result = InitArgsAndLocals(interp, procNameObj, skip);
-    if (result != TCL_OK) {
-	freePtr = iPtr->framePtr;
-	Tcl_PopCallFrame(interp);	/* Pop but do not free. */
-	TclStackFree(interp, freePtr->compiledLocals);
-					/* Free compiledLocals. */
-	TclStackFree(interp, freePtr);	/* Free CallFrame. */
-	return TCL_ERROR;
-    }
+    /*
+     * Invoke the commands in the procedure's body.
+     */
 
-#if defined(TCL_COMPILE_DEBUG)
+#ifdef TCL_COMPILE_DEBUG
     if (tclTraceExec >= 1) {
-	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, "Calling proc ");
+	for (i = 0;  i < objc;  i++) {
+	    TclPrintObject(stdout, objv[i], 15);
 	    fprintf(stdout, " ");
 	}
 	fprintf(stdout, "\n");
@@ -1787,157 +1198,66 @@ TclNRInterpProcCore(
 
 #ifdef USE_DTRACE
     if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
-	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
-	const char *a[10];
-	int i;
-
-	for (i = 0 ; i < 10 ; i++) {
-	    a[i] = (l < iPtr->varFramePtr->objc ?
-		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL);
-	    l++;
+	char *a[10];
+	int i = 0;
+
+	while (i < 10) {
+	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
 	}
 	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
 		a[8], a[9]);
     }
-    if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
-	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
-	const char *a[6]; int i[2];
-
-	TclDTraceInfo(info, a, i);
-	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
-	TclDecrRefCount(info);
-    }
-    if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
-	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
+#endif /* USE_DTRACE */
 
-	TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
-		TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
-		iPtr->varFramePtr->objc - l - 1,
-		(Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
-    }
+    iPtr->returnCode = TCL_OK;
+    procPtr->refCount++;
     if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
-	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
-
-	TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
-		TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
-		iPtr->varFramePtr->objc - l - 1,
-		(Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
+	TCL_DTRACE_PROC_ENTRY(TclGetString(objv[0]), objc - 1,
+		(Tcl_Obj **)(objv + 1));
     }
-#endif /* USE_DTRACE */
-
-    /*
-     * Invoke the commands in the procedure's body.
+#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.
      */
 
-    procPtr->refCount++;
-    codePtr = procPtr->bodyPtr->internalRep.otherValuePtr;
-
-    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
-	    NULL, NULL);
-    return TclNRExecuteByteCode(interp, codePtr);
-}
-
-static int
-InterpProcNR2(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    Interp *iPtr = (Interp *) interp;
-    Proc *procPtr = iPtr->varFramePtr->procPtr;
-    CallFrame *freePtr;
-    Tcl_Obj *procNameObj = data[0];
-    ProcErrorProc *errorProc = (ProcErrorProc *)data[1];
-
+    result = TclCompEvalObj(interp, procPtr->bodyPtr, NULL, 0);
+#endif
     if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
-	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
-
-	TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
-		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
+	TCL_DTRACE_PROC_RETURN(TclGetString(objv[0]), result);
     }
-    if (--procPtr->refCount <= 0) {
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
 	TclProcCleanupProc(procPtr);
     }
 
-    /*
-     * 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);
-	Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", 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 */
+    if (result != TCL_OK) {
+	result = ProcessProcResultCode(interp, procName, nameLen, result);
     }
 
+#ifdef USE_DTRACE
     if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
-	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
-	Tcl_Obj *r = Tcl_GetObjResult(interp);
+	Tcl_Obj *r;
 
-	TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
-		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
+	r = Tcl_GetObjResult(interp);
+	TCL_DTRACE_PROC_RESULT(TclGetString(objv[0]), result,
 		TclGetString(r), r);
     }
+#endif /* USE_DTRACE */
 
     /*
-     * 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.
+     * Pop and free the call frame for this procedure invocation, then
+     * free the compiledLocals array if malloc'ed storage was used.
      */
 
-    freePtr = iPtr->framePtr;
-    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
-    TclStackFree(interp, freePtr->compiledLocals);
-					/* Free compiledLocals. */
-    TclStackFree(interp, freePtr);	/* Free CallFrame. */
-
+    procDone:
+    Tcl_PopCallFrame(interp);
+    if (compiledLocals != localStorage) {
+	ckfree((char *) compiledLocals);
+    }
     return result;
+#undef NUM_LOCALS
 }
 
 /*
@@ -1945,165 +1265,251 @@ InterpProcNR2(
  *
  * 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 function 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 procedure 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(
-    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(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. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_CallFrame *framePtr;
-    ByteCode *codePtr = bodyPtr->internalRep.otherValuePtr;
+    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 */
+{
+    Interp *iPtr = (Interp*)interp;
+    int i, result;
+    Tcl_CallFrame frame;
+    ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
+    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)
-		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
-	    return TCL_OK;
-	}
-
-	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
-	    if ((Interp *) *codePtr->interpHandle != iPtr) {
-		Tcl_AppendResult(interp,
-			"a precompiled script jumped interps", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
-			"CROSSINTERPBYTECODE", NULL);
-		return TCL_ERROR;
-	    }
-	    codePtr->compileEpoch = iPtr->compileEpoch;
-	    codePtr->nsPtr = nsPtr;
-	} else {
-	    TclFreeIntRep(bodyPtr);
-	}
+ 	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 (bodyPtr->typePtr != &tclByteCodeType) {
-	Tcl_HashEntry *hePtr;
+ 	int numChars;
+ 	char *ellipsis;
 
 #ifdef TCL_COMPILE_DEBUG
-	if (tclTraceCompile >= 1) {
-	    /*
-	     * Display a line summarizing the top level command we are about
-	     * to compile.
-	     */
-
-	    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);
-	}
+ 	if (tclTraceCompile >= 1) {
+ 	    /*
+ 	     * 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);
+ 	}
 #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.
-	 *
-	 * 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.
-	 */
-
-	iPtr->compiledProcPtr = procPtr;
+ 	/*
+ 	 * 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.
+ 	 */
+
+	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;
+	    Tcl_IncrRefCount(bodyPtr);
+	    new->numArgs = procPtr->numArgs;
+
+	    new->numCompiledLocals = new->numArgs;
+	    new->firstLocalPtr = NULL;
+	    new->lastLocalPtr = NULL;
+	    localPtr = procPtr->firstLocalPtr;
+	    for (i = 0; i < new->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;
+		} else {
+		    new->lastLocalPtr->nextPtr = copy;
+		    new->lastLocalPtr = copy;
+		}
+		copy->nextPtr = NULL;
+		copy->nameLength = localPtr->nameLength;
+		copy->frameIndex = localPtr->frameIndex;
+		copy->flags = localPtr->flags;
+		copy->defValuePtr = localPtr->defValuePtr;
+		if (copy->defValuePtr) {
+		    Tcl_IncrRefCount(copy->defValuePtr);
+		}
+		copy->resolveInfo = localPtr->resolveInfo;
+		memcpy(copy->name, localPtr->name,  localPtr->nameLength + 1);
+	    }
 
-	if (procPtr->numCompiledLocals > procPtr->numArgs) {
-	    CompiledLocal *clPtr = procPtr->firstLocalPtr;
-	    CompiledLocal *lastPtr = NULL;
-	    int i, numArgs = procPtr->numArgs;
 
-	    for (i = 0; i < numArgs; i++) {
-		lastPtr = clPtr;
-		clPtr = clPtr->nextPtr;
+	    /* Reset the ClientData */
+	    Tcl_GetCommandInfoFromToken(token, &info);
+	    if (info.objClientData == (ClientData) procPtr) {
+	        info.objClientData = (ClientData) new;
 	    }
-
-	    if (lastPtr) {
-		lastPtr->nextPtr = NULL;
-	    } else {
-		procPtr->firstLocalPtr = NULL;
+	    if (info.clientData == (ClientData) procPtr) {
+	        info.clientData = (ClientData) new;
 	    }
-	    procPtr->lastLocalPtr = lastPtr;
-	    while (clPtr) {
-		CompiledLocal *toFree = clPtr;
-
-		clPtr = clPtr->nextPtr;
-		if (toFree->resolveInfo) {
-		    if (toFree->resolveInfo->deleteProc) {
-			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
-		    } else {
-			ckfree(toFree->resolveInfo);
-		    }
-		}
-		ckfree(toFree);
+	    if (info.deleteData == (ClientData) procPtr) {
+	        info.deleteData = (ClientData) new;
 	    }
-	    procPtr->numCompiledLocals = procPtr->numArgs;
-	}
+	    Tcl_SetCommandInfoFromToken(token, &info);
 
-	TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
-		/* isProcCallFrame */ 0);
+	    procPtr->refCount--;
+	    *procPtrPtr = procPtr = new;
+	}
+ 	iPtr->compiledProcPtr = procPtr;
 
-	/*
-	 * TIP #280: We get the invoking context from the cmdFrame which
-	 * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
-	 */
+ 	result = Tcl_PushCallFrame(interp, &frame,
+		(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
 
-	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
+ 	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).
+	     */
 
-	/*
-	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
-	 */
+	    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr);
 
-	iPtr->invokeWord = 0;
-	iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
-	tclByteCodeType.setFromAnyProc(interp, bodyPtr);
-	iPtr->invokeCmdFramePtr = NULL;
-	TclPopStackFrame(interp);
+	    /* 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);
+	}
+
+ 	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;
+ 	}
     } 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.
 	 */
 
-	codePtr->nsEpoch = nsPtr->resolverEpoch;
-	codePtr->flags |= TCL_BYTECODE_RESOLVE_VARS;
+	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;
+	    }
+	}
     }
     return TCL_OK;
 }
@@ -2111,36 +1517,68 @@ TclProcCompileProc(
 /*
  *----------------------------------------------------------------------
  *
- * MakeProcError --
+ * ProcessProcResultCode --
  *
- *	Function called by TclObjInterpProc to create the stack information
- *	upon an error from a procedure.
+ *	Procedure called by TclObjInterpProc to process a return code other
+ *	than TCL_OK returned by a Tcl procedure.
  *
  * Results:
- *	The interpreter's error info trace is set to a value that supplements
- *	the error code.
+ *	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.
  *
  * Side effects:
- *	none.
+ *	If the result returned is TCL_ERROR, traceback information about
+ *	the procedure just executed is appended to the interpreter's
+ *	"errorInfo" variable.
  *
  *----------------------------------------------------------------------
  */
 
-static void
-MakeProcError(
-    Tcl_Interp *interp,		/* The interpreter in which the procedure was
-				 * called. */
-    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
+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
 				 * messages and trace information. */
+    int nameLen;		/* Number of bytes in procedure's name. */
+    int returnCode;		/* The unexpected result code. */
 {
-    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 ? "..." : ""), Tcl_GetErrorLine(interp)));
+    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;
 }
 
 /*
@@ -2148,26 +1586,26 @@ MakeProcError(
  *
  * TclProcDeleteProc --
  *
- *	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.
+ *	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.
  *
  * 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)	/* Procedure to be deleted. */
+TclProcDeleteProc(clientData)
+    ClientData clientData;		/* Procedure to be deleted. */
 {
-    Proc *procPtr = clientData;
+    Proc *procPtr = (Proc *) clientData;
 
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
@@ -2180,8 +1618,9 @@ TclProcDeleteProc(
  *
  * TclProcCleanupProc --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -2193,66 +1632,64 @@ TclProcDeleteProc(
  */
 
 void
-TclProcCleanupProc(
-    register Proc *procPtr)	/* Procedure to be deleted. */
+TclProcCleanupProc(procPtr)
+    register Proc *procPtr;		/* Procedure to be deleted. */
 {
     register CompiledLocal *localPtr;
     Tcl_Obj *bodyPtr = procPtr->bodyPtr;
     Tcl_Obj *defPtr;
     Tcl_ResolvedVarInfo *resVarInfo;
-    Tcl_HashEntry *hePtr = NULL;
-    CmdFrame *cfPtr = NULL;
-    Interp *iPtr = procPtr->iPtr;
+#ifdef TCL_TIP280
+    Tcl_HashEntry* hePtr = NULL;
+    CmdFrame*      cfPtr = NULL;
+    Interp*        iPtr  = procPtr->iPtr;
+#endif
 
     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);
+		(*resVarInfo->deleteProc)(resVarInfo);
 	    } else {
-		ckfree(resVarInfo);
+		ckfree((char *) resVarInfo);
 	    }
-	}
+        }
 
 	if (localPtr->defValuePtr != NULL) {
 	    defPtr = localPtr->defValuePtr;
 	    Tcl_DecrRefCount(defPtr);
 	}
-	ckfree(localPtr);
+	ckfree((char *) localPtr);
 	localPtr = nextPtr;
     }
-    ckfree(procPtr);
+    ckfree((char *) procPtr);
 
-    /*
-     * TIP #280: Release the location data associated with this Proc
+#ifdef TCL_TIP280
+    /* TIP #280. Release the location data associated with this Proc
      * structure, if any. The interpreter may not exist (For example for
-     * procbody structures created by tbcload.
+     * procbody structurues created by tbcload.
      */
 
-    if (!iPtr) {
-	return;
-    }
+    if (!iPtr) return;
 
-    hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
-    if (!hePtr) {
-	return;
-    }
+    hePtr = Tcl_FindHashEntry (iPtr->linePBodyPtr, (char *) procPtr);
+    if (!hePtr) return;
 
-    cfPtr = Tcl_GetHashValue(hePtr);
+    cfPtr = (CmdFrame*) Tcl_GetHashValue (hePtr);
 
     if (cfPtr->type == TCL_LOCATION_SOURCE) {
-	Tcl_DecrRefCount(cfPtr->data.eval.path);
+        Tcl_DecrRefCount (cfPtr->data.eval.path);
 	cfPtr->data.eval.path = NULL;
     }
-    ckfree(cfPtr->line);
-    cfPtr->line = NULL;
-    ckfree(cfPtr);
-    Tcl_DeleteHashEntry(hePtr);
+    ckfree ((char*) cfPtr->line); cfPtr->line = NULL;
+    ckfree ((char*) cfPtr);
+    Tcl_DeleteHashEntry (hePtr);
+#endif
 }
 
 /*
@@ -2260,44 +1697,47 @@ TclProcCleanupProc(
  *
  * TclUpdateReturnInfo --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	The return value is the true completion code to use for the procedure
- *	or script, instead of TCL_RETURN.
+ *	The return value is the true completion code to use for
+ *	the procedure, instead of TCL_RETURN.
  *
  * Side effects:
- *	None.
+ *	The errorInfo and errorCode variables may get modified.
  *
  *----------------------------------------------------------------------
  */
 
 int
-TclUpdateReturnInfo(
-    Interp *iPtr)		/* Interpreter for which TCL_RETURN exception
-				 * is being processed. */
+TclUpdateReturnInfo(iPtr)
+    Interp *iPtr;		/* Interpreter for which TCL_RETURN
+				 * exception is being processed. */
 {
-    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].
-	 */
+    int code;
+    char *errorCode;
+    Tcl_Obj *objPtr;
 
-	code = iPtr->returnCode;
-	iPtr->returnLevel = 1;
-	iPtr->returnCode = TCL_OK;
-	if (code == TCL_ERROR) {
-	    iPtr->flags |= ERR_LEGACY_COPY;
+    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;
 	}
     }
     return code;
@@ -2306,24 +1746,49 @@ TclUpdateReturnInfo(
 /*
  *----------------------------------------------------------------------
  *
+ * 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 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.
+ *  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.
  *
  * Results:
- *	Returns the internal address of the TclObjInterpProc function.
+ *  Returns the internal address of the TclObjInterpProc procedure.
  *
  * Side effects:
- *	None.
+ *  None.
  *
  *----------------------------------------------------------------------
  */
 
 TclObjCmdProcType
-TclGetObjInterpProc(void)
+TclGetObjInterpProc()
 {
     return (TclObjCmdProcType) TclObjInterpProc;
 }
@@ -2333,37 +1798,38 @@ TclGetObjInterpProc(void)
  *
  * 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, NULL on error.
+ *  Returns a pointer to a newly allocated Tcl_Obj, 0 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(
-    Proc *procPtr)		/* the Proc struct to store as the internal
-				 * representation. */
+TclNewProcBodyObj(procPtr)
+    Proc *procPtr;	/* the Proc struct to store as the internal
+                         * representation. */
 {
     Tcl_Obj *objPtr;
 
     if (!procPtr) {
-	return NULL;
+        return (Tcl_Obj *) NULL;
     }
 
-    TclNewObj(objPtr);
+    objPtr = Tcl_NewStringObj("", 0);
+
     if (objPtr) {
-	objPtr->typePtr = &tclProcBodyType;
-	objPtr->internalRep.otherValuePtr = procPtr;
+        objPtr->typePtr = &tclProcBodyType;
+        objPtr->internalRep.otherValuePtr = (VOID *) procPtr;
 
-	procPtr->refCount++;
+        procPtr->refCount++;
     }
 
     return objPtr;
@@ -2374,27 +1840,27 @@ TclNewProcBodyObj(
  *
  * 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(
-    Tcl_Obj *srcPtr,		/* Object to copy. */
-    Tcl_Obj *dupPtr)		/* Target object for the duplication. */
+static void ProcBodyDup(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;		/* object to copy */
+    Tcl_Obj *dupPtr;		/* target object for the duplication */
 {
-    Proc *procPtr = srcPtr->internalRep.otherValuePtr;
+    Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
 
     dupPtr->typePtr = &tclProcBodyType;
-    dupPtr->internalRep.otherValuePtr = procPtr;
+    dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
     procPtr->refCount++;
 }
 
@@ -2403,668 +1869,130 @@ ProcBodyDup(
  *
  * 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(
-    Tcl_Obj *objPtr)		/* The object to clean up. */
+ProcBodyFree(objPtr)
+    Tcl_Obj *objPtr;		/* the object to clean up */
 {
-    Proc *procPtr = objPtr->internalRep.otherValuePtr;
-
+    Proc *procPtr = (Proc *) objPtr->internalRep.otherValuePtr;
     procPtr->refCount--;
     if (procPtr->refCount <= 0) {
-	TclProcCleanupProc(procPtr);
+        TclProcCleanupProc(procPtr);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * DupLambdaInternalRep, FreeLambdaInternalRep, SetLambdaFromAny --
+ * ProcBodySetFromAny --
  *
- *	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).
+ *  Tcl_ObjType's SetFromAny function for the proc body object.
+ *  Calls panic.
+ *
+ * Results:
+ *  Theoretically returns a TCL result code.
+ *
+ * Side effects:
+ *  Calls panic, since we can't set the value of the object from a string
+ *  representation (or any other internal ones).
  *
  *----------------------------------------------------------------------
  */
 
-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
-SetLambdaFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    register Tcl_Obj *objPtr)	/* The object to convert. */
+ProcBodySetFromAny(interp, objPtr)
+    Tcl_Interp *interp;			/* current interpreter */
+    Tcl_Obj *objPtr;			/* object pointer */
 {
-    Interp *iPtr = (Interp *) interp;
-    const char *name;
-    Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
-    int objc, result;
-    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))) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't interpret \"%s\" as a lambda expression",
-		Tcl_GetString(objPtr)));
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
-	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;
+    panic("called ProcBodySetFromAny");
 
     /*
-     * 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.
+     * this to keep compilers happy.
      */
 
-    if (iPtr->cmdFramePtr) {
-	CmdFrame *contextPtr = 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 isNew, buf[2];
-		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
-
-		/*
-		 * Move from approximation (line of list cmd word) to actual
-		 * location (line of 2nd list element).
-		 */
-
-		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);
-
-		cfPtr->level = -1;
-		cfPtr->type = contextPtr->type;
-		cfPtr->line = 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;
-
-		Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-			procPtr, &isNew), cfPtr);
-	    }
-
-	    /*
-	     * '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);
-    }
-
-    /*
-     * 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 {
-	const char *nsName = TclGetString(objv[2]);
-
-	if ((*nsName != ':') || (*(nsName+1) != ':')) {
-	    TclNewLiteralStringObj(nsObjPtr, "::");
-	    Tcl_AppendObjToObj(nsObjPtr, objv[2]);
-	} else {
-	    nsObjPtr = objv[2];
-	}
-    }
-
-    Tcl_IncrRefCount(nsObjPtr);
-
-    /*
-     * 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.
-     */
-
-    TclFreeIntRep(objPtr);
-
-    objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
-    objPtr->typePtr = &lambdaType;
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_ApplyObjCmd --
+ * ProcBodyUpdateString --
  *
- *	This object-based function is invoked to process the "apply" Tcl
- *	command. See the user documentation for details on what it does.
+ *  Tcl_ObjType's UpdateString function for the proc body object.
+ *  Calls panic.
  *
  * Results:
- *	A standard Tcl object result value.
+ *  None.
  *
  * Side effects:
- *	Depends on the content of the lambda term (i.e., objv[1]).
+ *  Calls panic, since we this type has no string representation.
  *
  *----------------------------------------------------------------------
  */
 
-int
-Tcl_ApplyObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, dummy, objc, objv);
-}
-
-int
-TclNRApplyObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+static void
+ProcBodyUpdateString(objPtr)
+    Tcl_Obj *objPtr;		/* the object to update */
 {
-    Interp *iPtr = (Interp *) interp;
-    Proc *procPtr = NULL;
-    Tcl_Obj *lambdaPtr, *nsObjPtr;
-    int result, isRootEnsemble;
-    Tcl_Namespace *nsPtr;
-    ApplyExtraData *extraPtr;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?");
-	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
-/*
- * Note: this code is NOT FUNCTIONAL due to the NR implementation; DO NOT
- * ENABLE! Leaving here as reminder to (a) TIP the suggestion, and (b) adapt
- * the code. (MS)
- */
-
-#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;
-    }
-
-    /*
-     * 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 TCL_ERROR;
-    }
-
-    extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData));
-    memset(&extraPtr->cmd, 0, sizeof(Command));
-    procPtr->cmdPtr = &extraPtr->cmd;
-    extraPtr->cmd.nsPtr = (Namespace *) nsPtr;
-
-    /*
-     * 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.
-     */
-
-    extraPtr->efi.length = 1;
-    extraPtr->efi.fields[0].name = "lambda";
-    extraPtr->efi.fields[0].proc = NULL;
-    extraPtr->efi.fields[0].clientData = lambdaPtr;
-    extraPtr->cmd.clientData = &extraPtr->efi;
-
-    isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
-    if (isRootEnsemble) {
-	iPtr->ensembleRewrite.sourceObjs = objv;
-	iPtr->ensembleRewrite.numRemovedObjs = 1;
-	iPtr->ensembleRewrite.numInsertedObjs = 0;
-    } else {
-	iPtr->ensembleRewrite.numInsertedObjs -= 1;
-    }
-    extraPtr->isRootEnsemble = isRootEnsemble;
-
-    result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
-    if (result == TCL_OK) {
-	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
-	result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
-    }
-    return result;
+    panic("called ProcBodyUpdateString");
 }
 
-static int
-ApplyNR2(
-    ClientData data[],
-    Tcl_Interp *interp,
-    int result)
-{
-    ApplyExtraData *extraPtr = data[0];
-
-    if (extraPtr->isRootEnsemble) {
-	((Interp *) interp)->ensembleRewrite.sourceObjs = NULL;
-    }
 
-    TclStackFree(interp, extraPtr);
-    return result;
-}
-
 /*
  *----------------------------------------------------------------------
  *
- * MakeLambdaError --
+ * TclCompileNoOp --
  *
- *	Function called by TclObjInterpProc to create the stack information
- *	upon an error from a lambda term.
+ *	Procedure called to compile noOp's
  *
  * Results:
- *	The interpreter's error info trace is set to a value that supplements
- *	the error code.
+ *	The return value is TCL_OK, indicating successful compilation.
  *
  * Side effects:
- *	none.
+ *	Instructions are added to envPtr to execute a noOp at runtime.
  *
  *----------------------------------------------------------------------
  */
 
-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 ? "..." : ""), Tcl_GetErrorLine(interp)));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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. */
+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 const char *const types[] = {
-	"lambda", "method", "objmethod", "proc", "script", NULL
-    };
-    enum Types {
-	DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
-	DISAS_SCRIPT
-    };
-    int idx, result;
-    Tcl_Obj *codeObjPtr = NULL;
-    Proc *procPtr = NULL;
-    Tcl_HashEntry *hPtr;
-    Object *oPtr;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "type ...");
-	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: {
-	Command cmd;
-	Tcl_Obj *nsObjPtr;
-	Tcl_Namespace *nsPtr;
-
-	/*
-	 * Compile (if uncompiled) and disassemble a lambda term.
-	 */
-
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
-	    return TCL_ERROR;
-	}
-	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;
+    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;
 	    }
-	    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;
+	    TclEmitOpcode(INST_POP, envPtr);
 	}
-	cmd.nsPtr = (Namespace *) nsPtr;
-	procPtr->cmdPtr = &cmd;
-	result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	TclPopStackFrame(interp);
-	codeObjPtr = procPtr->bodyPtr;
-	break;
     }
-    case DISAS_PROC:
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "procName");
-	    return TCL_ERROR;
-	}
-
-	procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
-	if (procPtr == NULL) {
-	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
-		    "\" isn't a procedure", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
-		    TclGetString(objv[2]), 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);
-	codeObjPtr = procPtr->bodyPtr;
-	break;
-    case DISAS_SCRIPT:
-	/*
-	 * Compile and disassemble a script.
-	 */
-
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "script");
-	    return TCL_ERROR;
-	}
-	if (objv[2]->typePtr != &tclByteCodeType) {
-	    if (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK){
-		return TCL_ERROR;
-	    }
-	}
-	codeObjPtr = objv[2];
-	break;
-
-    case DISAS_CLASS_METHOD:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Look up the body of a class method.
-	 */
-
-	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
-	if (oPtr == NULL) {
-	    return TCL_ERROR;
-	}
-	if (oPtr->classPtr == NULL) {
-	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
-		    "\" is not a class", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
-		    TclGetString(objv[2]), NULL);
-	    return TCL_ERROR;
-	}
-	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
-		(char *) objv[3]);
-	goto methodBody;
-    case DISAS_OBJECT_METHOD:
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Look up the body of an instance method.
-	 */
-
-	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
-	if (oPtr == NULL) {
-	    return TCL_ERROR;
-	}
-	if (oPtr->methodsPtr == NULL) {
-	    goto unknownMethod;
-	}
-	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
-
-	/*
-	 * Compile (if necessary) and disassemble a method body.
-	 */
-
-    methodBody:
-	if (hPtr == NULL) {
-	unknownMethod:
-	    Tcl_AppendResult(interp, "unknown method \"",
-		    TclGetString(objv[3]), "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
-		    TclGetString(objv[3]), NULL);
-	    return TCL_ERROR;
-	}
-	procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
-	if (procPtr == NULL) {
-	    Tcl_AppendResult(interp,
-		    "body not available for this kind of method", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
-		    "METHODTYPE", NULL);
-	    return TCL_ERROR;
-	}
-	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
-	    Command cmd;
-
-	    /*
-	     * Yes, this is ugly, but we need to pass the namespace in to the
-	     * compiler in two places.
-	     */
-
-	    cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
-	    procPtr->cmdPtr = &cmd;
-	    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
-		    (Namespace *) oPtr->namespacePtr, "body of method",
-		    TclGetString(objv[3]));
-	    procPtr->cmdPtr = NULL;
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	}
-	codeObjPtr = procPtr->bodyPtr;
-	break;
-    default:
-	CLANG_ASSERT(0);
-    }
-
-    /*
-     * Do the actual disassembly.
-     */
-
-    if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
-	    & TCL_BYTECODE_PRECOMPILED) {
-	Tcl_AppendResult(interp,"may not disassemble prebuilt bytecode",NULL);
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
-		"BYTECODE", NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
+    envPtr->currStackDepth = savedStackDepth;
+    TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
     return TCL_OK;
 }
 
@@ -3075,3 +2003,4 @@ Tcl_DisassembleObjCmd(
  * fill-column: 78
  * End:
  */
+
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 53d7153..c161d69 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -1,23 +1,24 @@
-/*
+/* 
  * 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
@@ -26,23 +27,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;
@@ -53,8 +54,8 @@
  *
  * *** NOTE: this code has been altered slightly for use in Tcl: ***
  * *** 1. Names have been changed, e.g. from re_comp to		 ***
- * ***    TclRegComp, to avoid clashes with other		 ***
- * ***    regexp implementations used by applications.		 ***
+ * ***    TclRegComp, to avoid clashes with other 		 ***
+ * ***    regexp implementations used by applications. 		 ***
  */
 
 /*
@@ -66,14 +67,15 @@
 
 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;
 
@@ -83,46 +85,49 @@ static Tcl_ThreadDataKey dataKey;
  * Declarations for functions used only in this file.
  */
 
-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);
+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));
 
 /*
- * 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.
  */
 
-const Tcl_ObjType tclRegexpType = {
+static 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 function is DEPRECATED in favor of the object version of the
- *	command.
+ *	Compile a regular expression into a form suitable for fast
+ *	matching.  This procedure 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 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.
+ *	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.
  *
  * Side effects:
  *	Updates the cache of compiled regexps.
@@ -131,13 +136,13 @@ const Tcl_ObjType tclRegexpType = {
  */
 
 Tcl_RegExp
-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. */
+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. */
 {
-    return (Tcl_RegExp) CompileRegexp(interp, pattern, (int) strlen(pattern),
+    return (Tcl_RegExp) CompileRegexp(interp, string, (int) strlen(string),
 	    REG_ADVANCED);
 }
 
@@ -146,14 +151,15 @@ Tcl_RegExpCompile(
  *
  * 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.
@@ -162,27 +168,27 @@ Tcl_RegExpCompile(
  */
 
 int
-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_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_GetRegExpFromObj. */
-    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. */
+    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. */
 {
     int flags, result, numChars;
-    TclRegexp *regexp = (TclRegexp *) re;
+    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 (text > start) {
+    if (string > start) {
 	flags = REG_NOTBOL;
     } else {
 	flags = 0;
@@ -192,7 +198,7 @@ Tcl_RegExpExec(
      * Remember the string for use by Tcl_RegExpRange().
      */
 
-    regexp->string = text;
+    regexp->string = string;
     regexp->objPtr = NULL;
 
     /*
@@ -200,10 +206,10 @@ Tcl_RegExpExec(
      */
 
     Tcl_DStringInit(&ds);
-    ustr = Tcl_UtfToUniCharDString(text, -1, &ds);
+    ustr = Tcl_UtfToUniCharDString(string, -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;
@@ -219,7 +225,7 @@ Tcl_RegExpExec(
  *
  * 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:
@@ -229,19 +235,19 @@ Tcl_RegExpExec(
  */
 
 void
-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. */
+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. */
 {
     TclRegexp *regexpPtr = (TclRegexp *) re;
-    const char *string;
+    CONST char *string;
 
     if ((size_t) index > regexpPtr->re.re_nsub) {
 	*startPtr = *endPtr = NULL;
@@ -249,7 +255,7 @@ Tcl_RegExpRange(
 	*startPtr = *endPtr = NULL;
     } else {
 	if (regexpPtr->objPtr) {
-	    string = TclGetString(regexpPtr->objPtr);
+	    string = Tcl_GetString(regexpPtr->objPtr);
 	} else {
 	    string = regexpPtr->string;
 	}
@@ -264,13 +270,14 @@ Tcl_RegExpRange(
  * 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.
@@ -279,17 +286,17 @@ Tcl_RegExpRange(
  */
 
 static int
-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. */
+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. */
 {
     int status;
     TclRegexp *regexpPtr = (TclRegexp *) re;
@@ -331,8 +338,8 @@ RegExpExecUniChar(
  *
  * 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.
@@ -341,17 +348,17 @@ RegExpExecUniChar(
  */
 
 void
-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. */
+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. */
 {
     TclRegexp *regexpPtr = (TclRegexp *) re;
 
@@ -375,9 +382,10 @@ TclRegExpRangeUniChar(
  *	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 "text" 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:
  *	None.
@@ -386,17 +394,19 @@ TclRegExpRangeUniChar(
  */
 
 int
-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_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_RegExp re = Tcl_RegExpCompile(interp, pattern);
+    Tcl_RegExp re;
 
+    re = Tcl_RegExpCompile(interp, pattern);
     if (re == NULL) {
 	return -1;
     }
-    return Tcl_RegExpExec(interp, re, text, text);
+    return Tcl_RegExpExec(interp, re, string, string);
 }
 
 /*
@@ -407,9 +417,10 @@ Tcl_RegExpMatch(
  *	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.
@@ -418,60 +429,38 @@ Tcl_RegExpMatch(
  */
 
 int
-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_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_GetRegExpFromObj. */
-    Tcl_Obj *textObj,		/* Text against which to match re. */
-    int offset,			/* Character index that marks where matching
+    Tcl_Obj *objPtr;		/* String 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 = textObj;
+    regexpPtr->objPtr = objPtr;
 
-    udata = Tcl_GetUnicodeFromObj(textObj, &length);
+    udata = Tcl_GetUnicodeFromObj(objPtr, &length);
 
     if (offset > length) {
 	offset = length;
     }
     udata += offset;
     length -= offset;
-
+    
     return RegExpExecUniChar(interp, re, udata, length, nmatches, flags);
 }
 
@@ -483,9 +472,10 @@ Tcl_RegExpExecObj(
  *	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 "text" 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:
  *	Changes the internal rep of the pattern and string objects.
@@ -494,10 +484,10 @@ Tcl_RegExpExecObj(
  */
 
 int
-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
+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
 				 * string. */
 {
     Tcl_RegExp re;
@@ -507,7 +497,7 @@ Tcl_RegExpMatchObj(
     if (re == NULL) {
 	return -1;
     }
-    return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
+    return Tcl_RegExpExecObj(interp, re, stringObj, 0 /* offset */,
 	    0 /* nmatches */, 0 /* flags */);
 }
 
@@ -528,9 +518,9 @@ Tcl_RegExpMatchObj(
  */
 
 void
-Tcl_RegExpGetInfo(
-    Tcl_RegExp regexp,		/* Pattern from which to get subexpressions. */
-    Tcl_RegExpInfo *infoPtr)	/* Match information is stored here. */
+Tcl_RegExpGetInfo(regexp, infoPtr)
+    Tcl_RegExp regexp;		/* Pattern from which to get subexpressions. */
+    Tcl_RegExpInfo *infoPtr;	/* Match information is stored here.  */
 {
     TclRegexp *regexpPtr = (TclRegexp *) regexp;
 
@@ -544,14 +534,14 @@ Tcl_RegExpGetInfo(
  *
  * Tcl_GetRegExpFromObj --
  *
- *	Compile a regular expression into a form suitable for fast matching.
- *	This function caches the result in a Tcl_Obj.
+ *	Compile a regular expression into a form suitable for fast
+ *	matching.  This procedure 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.
@@ -560,28 +550,25 @@ Tcl_RegExpGetInfo(
  */
 
 Tcl_RegExp
-Tcl_GetRegExpFromObj(
-    Tcl_Interp *interp,		/* For use in error reporting, and to access
+Tcl_GetRegExpFromObj(interp, objPtr, flags)
+    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;
-    const char *pattern;
+    char *pattern;
 
-    /*
-     * This is OK because we only actually interpret this value properly as a
-     * TclRegexp* when the type is tclRegexpType.
-     */
+    typePtr = objPtr->typePtr;
+    regexpPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
 
-    regexpPtr = objPtr->internalRep.otherValuePtr;
-
-    if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
-	pattern = TclGetStringFromObj(objPtr, &length);
+    if ((typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+	pattern = Tcl_GetStringFromObj(objPtr, &length);
 
 	regexpPtr = CompileRegexp(interp, pattern, length, flags);
 	if (regexpPtr == NULL) {
@@ -590,7 +577,7 @@ Tcl_GetRegExpFromObj(
 
 	/*
 	 * 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.
 	 */
 
@@ -600,8 +587,10 @@ Tcl_GetRegExpFromObj(
 	 * Free the old representation and set our type.
 	 */
 
-	TclFreeIntRep(objPtr);
-	objPtr->internalRep.otherValuePtr = regexpPtr;
+	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	    (*typePtr->freeIntRepProc)(objPtr);
+	}
+	objPtr->internalRep.otherValuePtr = (VOID *) regexpPtr;
 	objPtr->typePtr = &tclRegexpType;
     }
     return (Tcl_RegExp) regexpPtr;
@@ -615,10 +604,10 @@ Tcl_GetRegExpFromObj(
  *	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.
@@ -627,16 +616,16 @@ Tcl_GetRegExpFromObj(
  */
 
 int
-TclRegAbout(
-    Tcl_Interp *interp,		/* For use in variable assignment. */
-    Tcl_RegExp re)		/* The compiled regular expression. */
+TclRegAbout(interp, re)
+    Tcl_Interp *interp;		/* For use in variable assignment. */
+    Tcl_RegExp re;		/* The compiled regular expression. */
 {
-    TclRegexp *regexpPtr = (TclRegexp *) re;
-    struct infoname {
+    TclRegexp *regexpPtr = (TclRegexp *)re;
+    char buf[TCL_INTEGER_SPACE];
+    static struct infoname {
 	int bit;
-	const char *text;
-    };
-    static const struct infoname infonames[] = {
+	char *text;
+    } infonames[] = {
 	{REG_UBACKREF,		"REG_UBACKREF"},
 	{REG_ULOOKAHEAD,	"REG_ULOOKAHEAD"},
 	{REG_UBOUNDS,		"REG_UBOUNDS"},
@@ -651,42 +640,37 @@ TclRegAbout(
 	{REG_UEMPTYMATCH,	"REG_UEMPTYMATCH"},
 	{REG_UIMPOSSIBLE,	"REG_UIMPOSSIBLE"},
 	{REG_USHORTEST,		"REG_USHORTEST"},
-	{0,			NULL}
+	{0,			""}
     };
-    const struct infoname *inf;
-    Tcl_Obj *infoObj, *resultObj;
-
-    /*
-     * 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.
-     */
+    struct infoname *inf;
+    int n;
 
     Tcl_ResetResult(interp);
 
-    /*
-     * 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...
-     */
-
-    resultObj = Tcl_NewObj();
-    Tcl_ListObjAppendElement(NULL, resultObj,
-	    Tcl_NewIntObj((int) regexpPtr->re.re_nsub));
+    sprintf(buf, "%u", (unsigned)(regexpPtr->re.re_nsub));
+    Tcl_AppendElement(interp, buf);
 
     /*
-     * Now append a list of all the bit-flags set for the RE.
+     * Must count bits before generating list, because we must know
+     * whether {} are needed before we start appending names.
      */
-
-    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));
+    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);
 	}
     }
-    Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
-    Tcl_SetObjResult(interp, resultObj);
+    if (n != 1) {
+	Tcl_AppendResult(interp, "}", NULL);
+    }
 
     return 0;
 }
@@ -708,25 +692,26 @@ TclRegAbout(
  */
 
 void
-TclRegError(
-    Tcl_Interp *interp,		/* Interpreter for error reporting. */
-    const char *msg,		/* Message to prepend to error. */
-    int status)			/* Status code to report. */
+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. */
 {
     char buf[100];		/* ample in practice */
     char cbuf[100];		/* lots in practice */
     size_t n;
-    const char *p;
+    char *p;
 
     Tcl_ResetResult(interp);
-    n = TclReError(status, NULL, buf, sizeof(buf));
+    n = TclReError(status, (regex_t *)NULL, buf, sizeof(buf));
     p = (n > sizeof(buf)) ? "..." : "";
     Tcl_AppendResult(interp, msg, buf, p, NULL);
 
     sprintf(cbuf, "%d", status);
-    (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
+    (VOID) TclReError(REG_ITOA, (regex_t *)NULL, cbuf, sizeof(cbuf));
     Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -746,10 +731,10 @@ TclRegError(
  */
 
 static void
-FreeRegexpInternalRep(
-    Tcl_Obj *objPtr)		/* Regexp object with internal rep to free. */
+FreeRegexpInternalRep(objPtr)
+    Tcl_Obj *objPtr;		/* Regexp object with internal rep to free. */
 {
-    TclRegexp *regexpRepPtr = objPtr->internalRep.otherValuePtr;
+    TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.otherValuePtr;
 
     /*
      * If this is the last reference to the regexp, free it.
@@ -758,7 +743,6 @@ FreeRegexpInternalRep(
     if (--(regexpRepPtr->refCount) <= 0) {
 	FreeRegexp(regexpRepPtr);
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -766,8 +750,8 @@ FreeRegexpInternalRep(
  *
  * 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.
@@ -779,12 +763,11 @@ FreeRegexpInternalRep(
  */
 
 static void
-DupRegexpInternalRep(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+DupRegexpInternalRep(srcPtr, copyPtr)
+    Tcl_Obj *srcPtr;		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr;		/* Object with internal rep to set. */
 {
-    TclRegexp *regexpPtr = srcPtr->internalRep.otherValuePtr;
-
+    TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.otherValuePtr;
     regexpPtr->refCount++;
     copyPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
     copyPtr->typePtr = &tclRegexpType;
@@ -811,9 +794,9 @@ DupRegexpInternalRep(
  */
 
 static int
-SetRegexpFromAny(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr)		/* The object to convert. */
+SetRegexpFromAny(interp, objPtr)
+    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;
@@ -826,36 +809,37 @@ SetRegexpFromAny(
  *
  * 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(
-    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(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. */
 {
     TclRegexp *regexpPtr;
-    const Tcl_UniChar *uniString;
-    int numChars, status, i, exact;
+    CONST Tcl_UniChar *uniString;
+    int numChars;
     Tcl_DString stringBuf;
+    int status, i;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+ 
     if (!tsdPtr->initialized) {
 	tsdPtr->initialized = 1;
 	Tcl_CreateThreadExitHandler(FinalizeRegexp, NULL);
@@ -863,14 +847,14 @@ CompileRegexp(
 
     /*
      * 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++) {
@@ -878,8 +862,8 @@ CompileRegexp(
 		&& (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) {
@@ -904,8 +888,8 @@ CompileRegexp(
     /*
      * This is a new expression, so compile it and add it to the cache.
      */
-
-    regexpPtr = ckalloc(sizeof(TclRegexp));
+    
+    regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
     regexpPtr->objPtr = NULL;
     regexpPtr->string = NULL;
     regexpPtr->details.rm_extend.rm_so = -1;
@@ -932,34 +916,22 @@ CompileRegexp(
 	 * Clean up and report errors in the interpreter, if possible.
 	 */
 
-	ckfree(regexpPtr);
+	ckfree((char *)regexpPtr);
 	if (interp) {
 	    TclRegError(interp,
-		    "couldn't compile regular expression pattern: ", status);
+		    "couldn't compile regular expression pattern: ",
+		    status);
 	}
 	return NULL;
     }
 
     /*
-     * 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).
+     * Allocate enough space for all of the subexpressions, plus one
+     * extra for the entire pattern.
      */
 
-    if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
-	regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
-	Tcl_IncrRefCount(regexpPtr->globObjPtr);
-    } else {
-	regexpPtr->globObjPtr = NULL;
-    }
-
-    /*
-     * Allocate enough space for all of the subexpressions, plus one extra for
-     * the entire pattern.
-     */
-
-    regexpPtr->matches =
-	    ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
+    regexpPtr->matches = (regmatch_t *) ckalloc(
+	    sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
 
     /*
      * Initialize the refcount to one initially, since it is in the cache.
@@ -974,7 +946,6 @@ CompileRegexp(
 
     if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
 	TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];
-
 	if (--(oldRegexpPtr->refCount) <= 0) {
 	    FreeRegexp(oldRegexpPtr);
 	}
@@ -985,8 +956,8 @@ CompileRegexp(
 	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
 	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
     }
-    tsdPtr->patterns[0] = ckalloc(length + 1);
-    memcpy(tsdPtr->patterns[0], string, (unsigned) length + 1);
+    tsdPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
+    strcpy(tsdPtr->patterns[0], string);
     tsdPtr->patLengths[0] = length;
     tsdPtr->regexps[0] = regexpPtr;
 
@@ -1010,17 +981,14 @@ CompileRegexp(
  */
 
 static void
-FreeRegexp(
-    TclRegexp *regexpPtr)	/* Compiled regular expression to free. */
+FreeRegexp(regexpPtr)
+    TclRegexp *regexpPtr;	/* Compiled regular expression to free. */
 {
     TclReFree(&regexpPtr->re);
-    if (regexpPtr->globObjPtr) {
-	TclDecrRefCount(regexpPtr->globObjPtr);
-    }
     if (regexpPtr->matches) {
-	ckfree(regexpPtr->matches);
+	ckfree((char *) regexpPtr->matches);
     }
-    ckfree(regexpPtr);
+    ckfree((char *) regexpPtr);
 }
 
 /*
@@ -1028,7 +996,8 @@ FreeRegexp(
  *
  * FinalizeRegexp --
  *
- *	Release the storage associated with the per-thread regexp cache.
+ *	Release the storage associated with the per-thread regexp
+ *	cache.
  *
  * Results:
  *	None.
@@ -1040,8 +1009,8 @@ FreeRegexp(
  */
 
 static void
-FinalizeRegexp(
-    ClientData clientData)	/* Not used. */
+FinalizeRegexp(clientData)
+    ClientData clientData;	/* Not used. */
 {
     int i;
     TclRegexp *regexpPtr;
@@ -1055,19 +1024,9 @@ FinalizeRegexp(
 	ckfree(tsdPtr->patterns[i]);
 	tsdPtr->patterns[i] = NULL;
     }
-
     /*
      * We may find ourselves reinitialized if another finalization routine
      * invokes regexps.
      */
-
     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 3b2433e..f4c4cb6 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,21 +16,26 @@
 
 #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 {
     int flags;			/* Regexp compile flags. */
     regex_t re;			/* Compiled re, includes number of
 				 * subexpressions. */
-    const char *string;		/* Last string passed to Tcl_RegExpExec. */
+    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
@@ -42,11 +47,3 @@ 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 974737e..4463436 100644
--- a/generic/tclResolve.c
+++ b/generic/tclResolve.c
@@ -1,110 +1,112 @@
 /*
  * 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 functions local to this file:
+ * Declarations for procedures local to this file:
  */
 
-static void		BumpCmdRefEpochs(Namespace *nsPtr);
+static void		BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_AddInterpResolvers --
  *
- *	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.
+ *	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.
  *
- *	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.
+ *	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.
  *
  * Results:
- *	Returns pointers to the current name resolution functions in the
- *	cmdProcPtr, varProcPtr and compiledVarProcPtr arguments.
+ *	Returns pointers to the current name resolution procedures
+ *	in the cmdProcPtr, varProcPtr and compiledVarProcPtr
+ *	arguments.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 void
-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. */
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
+    Interp *iPtr = (Interp*)interp;
     ResolverScheme *resPtr;
-    unsigned len;
 
     /*
-     * 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 = ckalloc(sizeof(ResolverScheme));
-    len = strlen(name) + 1;
-    resPtr->name = ckalloc(len);
-    memcpy(resPtr->name, name, len);
+    resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
+    resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
+    strcpy(resPtr->name, name);
     resPtr->cmdResProc = cmdProc;
     resPtr->varResProc = varProc;
     resPtr->compiledVarResProc = compiledVarProc;
@@ -117,14 +119,15 @@ Tcl_AddInterpResolvers(
  *
  * Tcl_GetInterpResolvers --
  *
- *	Looks for a set of command/variable resolution functions with the
- *	given name in an interpreter. These functions are registered by
- *	calling Tcl_AddInterpResolvers.
+ *	Looks for a set of command/variable resolution procedures with
+ *	the given name in an interpreter.  These procedures are
+ *	registered by calling Tcl_AddInterpResolvers.
  *
  * Results:
- *	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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -133,29 +136,28 @@ Tcl_AddInterpResolvers(
  */
 
 int
-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 */
+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 */
 {
-    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 functions.
+     *  Look for an existing scheme with the given name.  If found,
+     *  then return pointers to its procedures.
      */
-
-    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;
@@ -166,69 +168,68 @@ Tcl_GetInterpResolvers(
  *
  * Tcl_RemoveInterpResolvers --
  *
- *	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.
+ *	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.
  *
  * 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 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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_RemoveInterpResolvers(
-    Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
-				 * being modified. */
-    const char *name)		/* Name of the scheme to be removed. */
+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. */
 {
-    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(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;
 }
@@ -238,139 +239,134 @@ Tcl_RemoveInterpResolvers(
  *
  * BumpCmdRefEpochs --
  *
- *	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.
+ *	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.
  *
  * 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(
-    Namespace *nsPtr)		/* Namespace being modified. */
+BumpCmdRefEpochs(nsPtr)
+    Namespace *nsPtr;			/* Namespace being modified. */
 {
     Tcl_HashEntry *entry;
     Tcl_HashSearch search;
+    Namespace *childNsPtr;
 
     nsPtr->cmdRefEpoch++;
 
-#ifndef BREAK_NAMESPACE_COMPAT
     for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
-	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
-	Namespace *childNsPtr = Tcl_GetHashValue(entry);
-
-	BumpCmdRefEpochs(childNsPtr);
-    }
-#else
-    if (nsPtr->childTablePtr != NULL) {
-	for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
-		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
-	    Namespace *childNsPtr = Tcl_GetHashValue(entry);
+	    entry != NULL;
+	    entry = Tcl_NextHashEntry(&search)) {
 
-	    BumpCmdRefEpochs(childNsPtr);
-	}
+        childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
+        BumpCmdRefEpochs(childNsPtr);
     }
-#endif
-    TclInvalidateNsPath(nsPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_SetNamespaceResolvers --
  *
- *	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.
+ *	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.
  *
  * 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(
-    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. */
+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. */
 {
-    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);
 }
 
 /*
@@ -378,15 +374,17 @@ Tcl_SetNamespaceResolvers(
  *
  * Tcl_GetNamespaceResolvers --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -395,30 +393,24 @@ Tcl_SetNamespaceResolvers(
  */
 
 int
-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. */
+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. */
 {
-    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 4443cc1..6dbdd90 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1,225 +1,39 @@
-/*
+/* 
  * 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"
 
 /*
- * Indices of the standard return options dictionary keys.
- */
-
-enum returnKeys {
-    KEY_CODE,	KEY_ERRORCODE,	KEY_ERRORINFO,	KEY_ERRORLINE,
-    KEY_LEVEL,	KEY_OPTIONS,	KEY_ERRORSTACK,	KEY_LAST
-};
-
-/*
- * Function prototypes for local functions in this file:
- */
-
-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;
-    Tcl_Obj *errorStack;
-    int resetErrorStack;
-} 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 = 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;
-    statePtr->errorStack = iPtr->errorStack;
-    statePtr->resetErrorStack = iPtr->resetErrorStack;
-    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);
-    }
-    if (statePtr->errorStack) {
-	Tcl_IncrRefCount(statePtr->errorStack);
-    }
-    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;
-    iPtr->resetErrorStack = statePtr->resetErrorStack;
-    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->errorStack) {
-	Tcl_DecrRefCount(iPtr->errorStack);
-    }
-    iPtr->errorStack = statePtr->errorStack;
-    if (iPtr->errorStack) {
-	Tcl_IncrRefCount(iPtr->errorStack);
-    }
-    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.
- *
- *----------------------------------------------------------------------
+ * Function prototypes for local procedures in this file:
  */
 
-void
-Tcl_DiscardInterpState(
-    Tcl_InterpState state)	/* saved interpreter state */
-{
-    InterpState *statePtr = (InterpState *) state;
+static void             ResetObjResult _ANSI_ARGS_((Interp *iPtr));
+static void		SetupAppendBuffer _ANSI_ARGS_((Interp *iPtr,
+			    int newSpace));
 
-    if (statePtr->errorInfo) {
-	Tcl_DecrRefCount(statePtr->errorInfo);
-    }
-    if (statePtr->errorCode) {
-	Tcl_DecrRefCount(statePtr->errorCode);
-    }
-    if (statePtr->returnOpts) {
-	Tcl_DecrRefCount(statePtr->returnOpts);
-    }
-    if (statePtr->errorStack) {
-	Tcl_DecrRefCount(statePtr->errorStack);
-    }
-    Tcl_DecrRefCount(statePtr->objResult);
-    ckfree(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.
@@ -231,24 +45,24 @@ Tcl_DiscardInterpState(
  */
 
 void
-Tcl_SaveResult(
-    Tcl_Interp *interp,		/* Interpreter to save. */
-    Tcl_SavedResult *statePtr)	/* Pointer to state structure. */
+Tcl_SaveResult(interp, statePtr)
+    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;
@@ -291,23 +105,23 @@ Tcl_SaveResult(
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter being restored. */
-    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
+Tcl_RestoreResult(interp, statePtr)
+    Tcl_Interp* interp;		/* Interpreter being restored. */
+    Tcl_SavedResult *statePtr;	/* State returned by Tcl_SaveResult. */
 {
     Interp *iPtr = (Interp *) interp;
 
@@ -331,7 +145,7 @@ Tcl_RestoreResult(
 	 */
 
 	if (iPtr->appendResult != NULL) {
-	    ckfree(iPtr->appendResult);
+	    ckfree((char *)iPtr->appendResult);
 	}
 
 	iPtr->appendResult = statePtr->appendResult;
@@ -359,22 +173,23 @@ Tcl_RestoreResult(
  *
  * Tcl_DiscardResult --
  *
- *	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.
+ *      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.
  *
  * Results:
- *	None.
+ *      None.
  *
  * Side effects:
- *	None.
+ *      None.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_DiscardResult(
-    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
+Tcl_DiscardResult(statePtr)
+    Tcl_SavedResult *statePtr;	/* State returned by Tcl_SaveResult. */
 {
     TclDecrRefCount(statePtr->objResultPtr);
 
@@ -384,7 +199,7 @@ Tcl_DiscardResult(
 	if (statePtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(statePtr->result);
 	} else {
-	    statePtr->freeProc(statePtr->result);
+	    (*statePtr->freeProc)(statePtr->result);
 	}
     }
 }
@@ -394,63 +209,63 @@ Tcl_DiscardResult(
  *
  * Tcl_SetResult --
  *
- *	Arrange for "result" to be the Tcl return value.
+ *	Arrange for "string" to be the Tcl return value.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	interp->result is left pointing either to "result" or to a copy of it.
- *	Also, the object result is reset.
+ *	interp->result is left pointing either to "string" (if "copy" is 0)
+ *	or to a copy of string. Also, the object result is reset.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetResult(
-    Tcl_Interp *interp,		/* Interpreter with which to associate the
+Tcl_SetResult(interp, string, freeProc)
+    Tcl_Interp *interp;		/* Interpreter with which to associate the
 				 * return value. */
-    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. */
+    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. */
 {
     Interp *iPtr = (Interp *) interp;
+    int length;
     register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
     char *oldResult = iPtr->result;
 
-    if (result == NULL) {
+    if (string == NULL) {
 	iPtr->resultSpace[0] = 0;
 	iPtr->result = iPtr->resultSpace;
 	iPtr->freeProc = 0;
     } else if (freeProc == TCL_VOLATILE) {
-	int length = strlen(result);
-
+	length = strlen(string);
 	if (length > TCL_RESULT_SIZE) {
-	    iPtr->result = ckalloc(length + 1);
+	    iPtr->result = (char *) ckalloc((unsigned) length+1);
 	    iPtr->freeProc = TCL_DYNAMIC;
 	} else {
 	    iPtr->result = iPtr->resultSpace;
 	    iPtr->freeProc = 0;
 	}
-	memcpy(iPtr->result, result, (unsigned) length+1);
+	strcpy(iPtr->result, string);
     } else {
-	iPtr->result = (char *) result;
+	iPtr->result = string;
 	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) {
 	if (oldFreeProc == TCL_DYNAMIC) {
 	    ckfree(oldResult);
 	} else {
-	    oldFreeProc(oldResult);
+	    (*oldFreeProc)(oldResult);
 	}
     }
 
@@ -478,22 +293,20 @@ Tcl_SetResult(
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_GetStringResult(
-    register Tcl_Interp *interp)/* Interpreter whose result to return. */
+CONST char *
+Tcl_GetStringResult(interp)
+     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.
      */
-
-    Interp *iPtr = (Interp *) interp;
-
-    if (*(iPtr->result) == 0) {
+    
+    if (*(interp->result) == 0) {
 	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
-		TCL_VOLATILE);
+	        TCL_VOLATILE);
     }
-    return iPtr->result;
+    return interp->result;
 }
 
 /*
@@ -507,20 +320,22 @@ Tcl_GetStringResult(
  *	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(
-    Tcl_Interp *interp,		/* Interpreter with which to associate the
+Tcl_SetObjResult(interp, objPtr)
+    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;
@@ -529,10 +344,10 @@ Tcl_SetObjResult(
     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);
 
     /*
@@ -543,7 +358,7 @@ Tcl_SetObjResult(
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
 	} else {
-	    iPtr->freeProc(iPtr->result);
+	    (*iPtr->freeProc)(iPtr->result);
 	}
 	iPtr->freeProc = 0;
     }
@@ -557,46 +372,46 @@ Tcl_SetObjResult(
  * 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 function 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 procedure 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(
-    Tcl_Interp *interp)		/* Interpreter whose result to return. */
+Tcl_GetObjResult(interp)
+    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);
 	    } else {
-		iPtr->freeProc(iPtr->result);
+		(*iPtr->freeProc)(iPtr->result);
 	    }
 	    iPtr->freeProc = 0;
 	}
@@ -611,51 +426,110 @@ Tcl_GetObjResult(
  *
  * Tcl_AppendResultVA --
  *
- *	Append a variable number of strings onto the interpreter's result.
+ *	Append a variable number of strings onto the interpreter's string
+ *	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 non-empty, the object result forced to be a
- *	duplicate of it first. There will be a string result afterwards.
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendResultVA(
-    Tcl_Interp *interp,		/* Interpreter with which to associate the
+Tcl_AppendResultVA (interp, argList)
+    Tcl_Interp *interp;		/* Interpreter with which to associate the
 				 * return value. */
-    va_list argList)		/* Variable argument list. */
+    va_list argList;		/* Variable argument list. */
 {
-    Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
+#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.
+     */
 
-    if (Tcl_IsShared(objPtr)) {
-	objPtr = Tcl_DuplicateObj(objPtr);
+    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;
     }
-    Tcl_AppendStringsToObjVA(objPtr, argList);
-    Tcl_SetObjResult(interp, objPtr);
 
     /*
-     * 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 the append buffer isn't already setup and large enough to hold
+     * the new data, set it up.
      */
 
-#ifdef USE_INTERP_RESULT
+    if ((iPtr->result != iPtr->appendResult)
+	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
+	    || ((newSpace + iPtr->appendUsed) >= iPtr->appendAvl)) {
+       SetupAppendBuffer(iPtr, newSpace);
+    }
+
     /*
-     * Ensure that the interp->result is legal so old Tcl 7.* code still
-     * works. There's still embarrasingly much of it about...
+     * Now go through all the argument strings again, copying them into the
+     * buffer.
      */
 
-    (void) Tcl_GetStringResult(interp);
-#endif /* USE_INTERP_RESULT */
+    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
 }
 
 /*
@@ -663,29 +537,30 @@ Tcl_AppendResultVA(
  *
  * Tcl_AppendResult --
  *
- *	Append a variable number of strings onto the interpreter's result.
+ *	Append a variable number of strings onto the interpreter's string
+ *	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 non-empty, the object result forced to be a
- *	duplicate of it first. There will be a string result afterwards.
+ *	If the string result is empty, the object result is moved to the
+ *	string result, then the object result is reset.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_AppendResult(
-    Tcl_Interp *interp, ...)
+Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 {
+    Tcl_Interp *interp;
     va_list argList;
 
-    va_start(argList, interp);
+    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
     Tcl_AppendResultVA(interp, argList);
     va_end(argList);
 }
@@ -702,10 +577,10 @@ Tcl_AppendResult(
  *	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.
@@ -714,11 +589,11 @@ Tcl_AppendResult(
  */
 
 void
-Tcl_AppendElement(
-    Tcl_Interp *interp,		/* Interpreter whose result is to be
+Tcl_AppendElement(interp, string)
+    Tcl_Interp *interp;		/* Interpreter whose result is to be
 				 * extended. */
-    const char *element)	/* String to convert to list element and add
-				 * to result. */
+    CONST char *string;		/* String to convert to list element and
+				 * add to result. */
 {
     Interp *iPtr = (Interp *) interp;
     char *dst;
@@ -726,27 +601,30 @@ Tcl_AppendElement(
     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.
      */
 
-    (void) Tcl_GetStringResult(interp);
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	        TCL_VOLATILE);
+    }
 
     /*
-     * 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(element, &flags) + 1;
+    size = Tcl_ScanElement(string, &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;
@@ -754,16 +632,8 @@ Tcl_AppendElement(
 	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(element, dst, flags);
+    iPtr->appendUsed += Tcl_ConvertElement(string, dst, flags);
 }
 
 /*
@@ -771,10 +641,10 @@ Tcl_AppendElement(
  *
  * SetupAppendBuffer --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -786,10 +656,10 @@ Tcl_AppendElement(
  */
 
 static void
-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. */
+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. */
 {
     int totalSpace;
 
@@ -801,9 +671,9 @@ SetupAppendBuffer(
 
     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) {
@@ -815,13 +685,13 @@ SetupAppendBuffer(
     } 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;
@@ -831,7 +701,7 @@ SetupAppendBuffer(
 	} else {
 	    totalSpace *= 2;
 	}
-	new = ckalloc(totalSpace);
+	new = (char *) ckalloc((unsigned) totalSpace);
 	strcpy(new, iPtr->result);
 	if (iPtr->appendResult != NULL) {
 	    ckfree(iPtr->appendResult);
@@ -841,7 +711,7 @@ SetupAppendBuffer(
     } else if (iPtr->result != iPtr->appendResult) {
 	strcpy(iPtr->appendResult, iPtr->result);
     }
-
+    
     Tcl_FreeResult((Tcl_Interp *) iPtr);
     iPtr->result = iPtr->appendResult;
 }
@@ -851,9 +721,9 @@ SetupAppendBuffer(
  *
  * Tcl_FreeResult --
  *
- *	This function frees up the memory associated with an interpreter's
+ *	This procedure 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 function is about to
+ *	Tcl_FreeResult is most commonly used when a procedure is about to
  *	replace one result value with another.
  *
  * Results:
@@ -861,28 +731,28 @@ SetupAppendBuffer(
  *
  * 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(
-    register Tcl_Interp *interp)/* Interpreter for which to free result. */
+Tcl_FreeResult(interp)
+    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);
 	} else {
-	    iPtr->freeProc(iPtr->result);
+	    (*iPtr->freeProc)(iPtr->result);
 	}
 	iPtr->freeProc = 0;
     }
-
+    
     ResetObjResult(iPtr);
 }
 
@@ -891,23 +761,24 @@ Tcl_FreeResult(
  *
  * Tcl_ResetResult --
  *
- *	This function resets both the interpreter's string and object results.
+ *	This procedure 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(
-    register Tcl_Interp *interp)/* Interpreter for which to clear result. */
+Tcl_ResetResult(interp)
+    register Tcl_Interp *interp; /* Interpreter for which to clear result. */
 {
     register Interp *iPtr = (Interp *) interp;
 
@@ -916,38 +787,13 @@ Tcl_ResetResult(
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
 	} else {
-	    iPtr->freeProc(iPtr->result);
+	    (*iPtr->freeProc)(iPtr->result);
 	}
 	iPtr->freeProc = 0;
     }
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
-    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->resetErrorStack = 1;
-    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);
+    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_IN_PROGRESS | ERROR_CODE_SET);
 }
 
 /*
@@ -955,22 +801,22 @@ Tcl_ResetResult(
  *
  * ResetObjResult --
  *
- *	Function used to reset an interpreter's Tcl result object.
+ *	Procedure 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(
-    register Interp *iPtr)	/* Points to the interpreter whose result
+ResetObjResult(iPtr)
+    register Interp *iPtr;	/* Points to the interpreter whose result
 				 * object should be reset. */
 {
     register Tcl_Obj *objResultPtr = iPtr->objResultPtr;
@@ -981,14 +827,17 @@ ResetObjResult(
 	Tcl_IncrRefCount(objResultPtr);
 	iPtr->objResultPtr = objResultPtr;
     } else {
-	if (objResultPtr->bytes != tclEmptyStringRep) {
-	    if (objResultPtr->bytes) {
-		ckfree(objResultPtr->bytes);
-	    }
-	    objResultPtr->bytes = tclEmptyStringRep;
-	    objResultPtr->length = 0;
+	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);
 	}
-	TclFreeIntRep(objResultPtr);
+	objResultPtr->typePtr = (Tcl_ObjType *) NULL;
     }
 }
 
@@ -997,41 +846,48 @@ ResetObjResult(
  *
  * Tcl_SetErrorCodeVA --
  *
- *	This function is called to record machine-readable information about
- *	an error that is about to be returned.
+ *	This procedure is called to record machine-readable information
+ *	about an error that is about to be returned.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetErrorCodeVA(
-    Tcl_Interp *interp,		/* Interpreter in which to set errorCode */
-    va_list argList)		/* Variable argument list. */
+Tcl_SetErrorCodeVA (interp, argList)
+    Tcl_Interp *interp;		/* Interpreter in which to access the errorCode
+				 * variable. */
+    va_list argList;		/* Variable argument list. */
 {
-    Tcl_Obj *errorObj = Tcl_NewObj();
+    char *string;
+    int flags;
+    Interp *iPtr = (Interp *) interp;
 
     /*
-     * Scan through the arguments one at a time, appending them to the
-     * errorCode field as list elements.
+     * Scan through the arguments one at a time, appending them to
+     * $errorCode as list elements.
      */
 
+    flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT;
     while (1) {
-	char *elem = va_arg(argList, char *);
-
-	if (elem == NULL) {
+	string = va_arg(argList, char *);
+	if (string == NULL) {
 	    break;
 	}
-	Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
+	(void) Tcl_SetVar2((Tcl_Interp *) iPtr, "errorCode",
+		(char *) NULL, string, flags);
+	flags |= TCL_APPEND_VALUE;
     }
-    Tcl_SetObjErrorCode(interp, errorObj);
+    iPtr->flags |= ERROR_CODE_SET;
 }
 
 /*
@@ -1039,32 +895,34 @@ Tcl_SetErrorCodeVA(
  *
  * Tcl_SetErrorCode --
  *
- *	This function is called to record machine-readable information about
- *	an error that is about to be returned.
+ *	This procedure is called to record machine-readable information
+ *	about an error that is about to be returned.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
-
+	/* VARARGS2 */
 void
-Tcl_SetErrorCode(
-    Tcl_Interp *interp, ...)
+Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1)
 {
+    Tcl_Interp *interp;
     va_list argList;
 
     /*
-     * Scan through the arguments one at a time, appending them to the
-     * errorCode field as list elements.
+     * Scan through the arguments one at a time, appending them to
+     * $errorCode as list elements.
      */
 
-    va_start(argList, interp);
+    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
     Tcl_SetErrorCodeVA(interp, argList);
     va_end(argList);
 }
@@ -1074,671 +932,116 @@ Tcl_SetErrorCode(
  *
  * Tcl_SetObjErrorCode --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	The errorCode field of the interp is set to the new value.
- *
- *----------------------------------------------------------------------
- */
-
-void
-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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_GetErrorLine --
- *
- * Results:
- *
- * Side effects:
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_GetErrorLine(
-    Tcl_Interp *interp)
-{
-    return ((Interp *) interp)->errorLine;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_SetErrorLine --
- *
- * Results:
- *
- * 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.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetErrorLine(
-    Tcl_Interp *interp,
-    int value)
+Tcl_SetObjErrorCode(interp, errorObjPtr)
+    Tcl_Interp *interp;
+    Tcl_Obj *errorObjPtr;
 {
-    ((Interp *) interp)->errorLine = value;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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)
-{
-    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_ERRORSTACK],"-errorstack");
-	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, 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 = 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_ERRORSTACK], &valuePtr);
-	if (valuePtr != NULL) {
-            int len, valueObjc;
-            Tcl_Obj **valueObjv;
-
-            if (Tcl_IsShared(iPtr->errorStack)) {
-                Tcl_Obj *newObj;
-                
-                newObj = Tcl_DuplicateObj(iPtr->errorStack);
-                Tcl_DecrRefCount(iPtr->errorStack);
-                Tcl_IncrRefCount(newObj);
-                iPtr->errorStack = newObj;
-            }
-            /*
-             * List extraction done after duplication to avoid moving the rug
-             * if someone does [return -errorstack [info errorstack]]
-             */
-            if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc, &valueObjv) == TCL_ERROR) {
-                return TCL_ERROR;
-            }
-            iPtr->resetErrorStack = 0;
-            Tcl_ListObjLength(interp, iPtr->errorStack, &len);
-            /* reset while keeping the list intrep as much as possible */
-            Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc, valueObjv);
- 	}
-	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 if 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) && (memcmp(opt, compare, optLen) == 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);
-		Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
-			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) {
-	if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, valuePtr, &code)) {
-	    goto error;
-	}
-	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);
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", 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);
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE",
-		    NULL);
-	    goto error;
-	}
-    }
-
-    /*
-     * Check for bogus -errorstack value.
-     */
-
-    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
-    if (valuePtr != NULL) {
-	int length;
-
-	if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
-	    /*
-	     * Value is not a list, which is illegal for -errorstack.
-	     */
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "bad -errorstack value: "
-		    "expected a list but got \"", TclGetString(valuePtr),
-                    "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
-                    NULL);
-	    goto error;
-	}
-        if (length % 2) {
-            /*
-             * Errorstack must always be an even-sized list
-             */
-            Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp,
-                    "forbidden odd-sized list for -errorstack: \"",
-		    TclGetString(valuePtr), "\"", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "RESULT",
-                    "ODDSIZEDLIST_ERRORSTACK", 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);
-        Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
-    }
-    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;
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * TclNoErrorStack --
- *
- *	Removes the -errorstack entry from an options dict to avoid reference cycles
- *
- * Results:
- *	The (unshared) argument options dict, modified in -place.
- *
- *-------------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options)
-{
-    Tcl_Obj **keys = GetKeys();
+    Interp *iPtr;
     
-    Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]);
-
-    return options;
+    iPtr = (Interp *) interp;
+    Tcl_SetVar2Ex(interp, "errorCode", NULL, errorObjPtr, TCL_GLOBAL_ONLY);
+    iPtr->flags |= ERROR_CODE_SET;
 }
 
 /*
  *-------------------------------------------------------------------------
  *
- * Tcl_SetReturnOptions --
- *
- *	Accepts an interp and a dictionary of return options, and sets the
- *	return options of the interp to match the dictionary.
+ * TclTransferResult --
  *
- * 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).
+ *	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.
  *
- * 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);
-	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_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;
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * Tcl_TransferResult --
- *
- *	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 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.
+ *	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.
  *
  * Side effects:
  *	None.
  *
  *-------------------------------------------------------------------------
  */
-
+	
 void
-Tcl_TransferResult(
-    Tcl_Interp *sourceInterp,	/* Interp whose result and error information
-				 * should be moved to the target interp.
-				 * After moving result, this interp's result
+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 
 				 * 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 *tiPtr = (Interp *) targetInterp;
-    Interp *siPtr = (Interp *) sourceInterp;
+    Interp *iPtr;
+    Tcl_Obj *objPtr;
 
     if (sourceInterp == targetInterp) {
 	return;
     }
 
-    if (result == TCL_OK && siPtr->returnOpts == NULL) {
+    if (result == TCL_ERROR) {
 	/*
-	 * Special optimization for the common case of normal command return
-	 * code and no explicit return options.
+	 * 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.
 	 */
 
-	if (tiPtr->returnOpts) {
-	    Tcl_DecrRefCount(tiPtr->returnOpts);
-	    tiPtr->returnOpts = NULL;
+	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;
 	}
-    } else {
-	Tcl_SetReturnOptions(targetInterp,
-		Tcl_GetReturnOptions(sourceInterp, result));
-	tiPtr->flags &= ~(ERR_ALREADY_LOGGED);
+
+	objPtr = Tcl_GetVar2Ex(sourceInterp, "errorCode", NULL,
+		TCL_GLOBAL_ONLY);
+	if (objPtr) {
+	    Tcl_SetObjErrorCode(targetInterp, objPtr);
+	}
+
     }
+
+    ((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
- * tab-width: 8
- * indent-tabs-mode: nil
- * End:
- */
diff --git a/generic/tclScan.c b/generic/tclScan.c
index d21bfaf..b72bd88 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -1,31 +1,41 @@
-/*
+/* 
  * 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_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_LONGER	0x400		/* Asked for a wide value. */
-#define SCAN_BIG	0x800		/* Asked for a bignum value. */
+#define SCAN_LONGER	0x400		  /* Asked for a wide 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 {
@@ -43,20 +53,20 @@ typedef struct CharSet {
  * Declarations for functions used only in this file.
  */
 
-static const char *	BuildCharSet(CharSet *cset, const char *format);
-static int		CharInSet(CharSet *cset, int ch);
-static void		ReleaseCharSet(CharSet *cset);
-static int		ValidateFormat(Tcl_Interp *interp, const char *format,
-			    int numVars, int *totalVars);
+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));
 
 /*
  *----------------------------------------------------------------------
  *
  * 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.
@@ -67,17 +77,17 @@ static int		ValidateFormat(Tcl_Interp *interp, const char *format,
  *----------------------------------------------------------------------
  */
 
-static const char *
-BuildCharSet(
-    CharSet *cset,
-    const char *format)		/* Points to first char of set. */
+static char *
+BuildCharSet(cset, format)
+    CharSet *cset;
+    char *format;		/* Points to first char of set. */
 {
     Tcl_UniChar ch, start;
     int offset, nranges;
-    const char *end;
+    char *end;
 
     memset(cset, 0, sizeof(CharSet));
-
+    
     offset = Tcl_UtfToUniChar(format, &ch);
     if (ch == '^') {
 	cset->exclude = 1;
@@ -101,9 +111,10 @@ BuildCharSet(
 	end += Tcl_UtfToUniChar(end, &ch);
     }
 
-    cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
+    cset->chars = (Tcl_UniChar *) ckalloc(sizeof(Tcl_UniChar)
+	    * (end - format - 1));
     if (nranges > 0) {
-	cset->ranges = ckalloc(sizeof(struct Range) * nranges);
+	cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
     } else {
 	cset->ranges = NULL;
     }
@@ -122,8 +133,8 @@ BuildCharSet(
     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;
@@ -150,7 +161,7 @@ BuildCharSet(
 		} else {
 		    cset->ranges[cset->nranges].start = ch;
 		    cset->ranges[cset->nranges].end = start;
-		}
+		}		    
 		cset->nranges++;
 	    }
 	} else {
@@ -178,14 +189,13 @@ BuildCharSet(
  */
 
 static int
-CharInSet(
-    CharSet *cset,
-    int c)			/* Character to test, passed as int because of
-				 * non-ANSI prototypes. */
+CharInSet(cset, c)
+    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;
@@ -194,13 +204,14 @@ CharInSet(
     }
     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);    
 }
 
 /*
@@ -220,12 +231,12 @@ CharInSet(
  */
 
 static void
-ReleaseCharSet(
-    CharSet *cset)
+ReleaseCharSet(cset)
+    CharSet *cset;
 {
-    ckfree(cset->chars);
+    ckfree((char *)cset->chars);
     if (cset->ranges) {
-	ckfree(cset->ranges);
+	ckfree((char *)cset->ranges);
     }
 }
 
@@ -234,8 +245,8 @@ ReleaseCharSet(
  *
  * 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.
@@ -247,27 +258,33 @@ ReleaseCharSet(
  */
 
 static int
-ValidateFormat(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    const 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(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
 				 * required. */
 {
+#define STATIC_LIST_SIZE 16
     int gotXpg, gotSequential, value, i, flags;
     char *end;
     Tcl_UniChar ch;
-    int objIndex, xpgSize, nspace = numVars;
-    int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
+    int staticAssign[STATIC_LIST_SIZE];
+    int *nassign = staticAssign;
+    int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
     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;
     }
@@ -292,14 +309,14 @@ ValidateFormat(
 	    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;
 	    }
@@ -316,32 +333,31 @@ ValidateFormat(
 		/*
 		 * 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);
-	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
 	    goto error;
 	}
 
-    xpgCheckDone:
+	xpgCheckDone:
 	/*
 	 * Parse any width specifier.
 	 */
 
-	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
-	    value = strtoul(format-1, (char **) &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);
 	}
@@ -352,12 +368,6 @@ ValidateFormat(
 
 	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':
@@ -373,106 +383,104 @@ ValidateFormat(
 	 */
 
 	switch (ch) {
-	case 'c':
-	    if (flags & SCAN_WIDTH) {
-		Tcl_SetResult(interp,
-			"field width may not be specified in %c conversion",
-			TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
-		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);
-		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
-		goto error;
-	    }
-	    /*
-	     * Fall through!
-	     */
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'i':
-	case 'o':
-	case 'x':
-	case 'b':
-	    break;
-	case 'u':
-	    if (flags & SCAN_BIG) {
-		Tcl_SetResult(interp,
-			"unsigned bignum scans are invalid", TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
-		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;
+	    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;
 		}
-		format += Tcl_UtfToUniChar(format, &ch);
-	    }
-	    if (ch == ']') {
-		if (*format == '\0') {
-		    goto badSet;
+		/*
+		 * 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;
 		}
-		format += Tcl_UtfToUniChar(format, &ch);
-	    }
-	    while (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);
+		}
+		while (ch != ']') {
+		    if (*format == '\0') {
+			goto badSet;
+		    }
+		    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);
+		goto error;
 	    }
-	    break;
-	badSet:
-	    Tcl_SetResult(interp, "unmatched [ in format string",
-		    TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
-	    goto error;
-	default:
-	    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
-	    Tcl_AppendResult(interp, "bad scan conversion character \"", buf,
-		    "\"", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", 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 += 16;	/* formerly STATIC_LIST_SIZE */
+		    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));
 		}
-		nassign = TclStackRealloc(interp, nassign,
-			nspace * sizeof(int));
 		for (i = value; i < nspace; i++) {
 		    nassign[i] = 0;
 		}
@@ -498,43 +506,39 @@ ValidateFormat(
     }
     for (i = 0; i < numVars; i++) {
 	if (nassign[i] > 1) {
-	    Tcl_SetResult(interp,
-		    "variable is assigned by multiple \"%n$\" conversion specifiers",
-		    TCL_STATIC);
-	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
+	    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_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
+	    Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);
 	    goto error;
 	}
     }
 
-    TclStackFree(interp, nassign);
+    if (nassign != staticAssign) {
+	ckfree((char *)nassign);
+    }
     return TCL_OK;
 
-  badIndex:
+    badIndex:
     if (gotXpg) {
 	Tcl_SetResult(interp, "\"%n$\" argument index out of range",
 		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
     } else {
-	Tcl_SetResult(interp,
+	Tcl_SetResult(interp, 
 		"different numbers of variable names and field specifiers",
 		TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
     }
 
-  error:
-    TclStackFree(interp, nassign);
+    error:
+    if (nassign != staticAssign) {
+	ckfree((char *)nassign);
+    }
     return TCL_ERROR;
+#undef STATIC_LIST_SIZE
 }
 
 /*
@@ -542,8 +546,8 @@ ValidateFormat(
  *
  * Tcl_ScanObjCmd --
  *
- *	This function is invoked to process the "scan" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "scan" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -556,30 +560,36 @@ ValidateFormat(
 
 	/* ARGSUSED */
 int
-Tcl_ScanObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    const char *format;
+    char *format;
     int numVars, nconversions, totalVars = -1;
     int objIndex, offset, i, result, code;
     long value;
-    const char *string, *end, *baseString;
+    char *string, *end, *baseString;
     char op = 0;
-    int width, underflow = 0;
+    int base = 0;
+    int underflow = 0;
+    size_t width;
+    long (*fn)() = NULL;
+#ifndef TCL_WIDE_INT_IS_LONG
+    Tcl_WideInt (*lfn)() = NULL;
     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,
-		"string format ?varName ...?");
+        Tcl_WrongNumArgs(interp, 1, objv,
+		"string format ?varName varName ...?");
 	return TCL_ERROR;
     }
 
@@ -589,7 +599,7 @@ Tcl_ScanObjCmd(
     /*
      * Check for errors in the format string.
      */
-
+    
     if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
 	return TCL_ERROR;
     }
@@ -599,7 +609,7 @@ Tcl_ScanObjCmd(
      */
 
     if (totalVars > 0) {
-	objs = ckalloc(sizeof(Tcl_Obj *) * totalVars);
+	objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
 	for (i = 0; i < totalVars; i++) {
 	    objs[i] = NULL;
 	}
@@ -609,15 +619,14 @@ Tcl_ScanObjCmd(
     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;
@@ -637,9 +646,9 @@ Tcl_ScanObjCmd(
 	    }
 	    continue;
 	}
-
+	    
 	if (ch != '%') {
-	literal:
+	    literal:
 	    if (*string == '\0') {
 		underflow = 1;
 		goto done;
@@ -657,18 +666,17 @@ Tcl_ScanObjCmd(
 	}
 
 	/*
-	 * 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. */
-	    char *formatEnd;
-	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
-	    if (*formatEnd == '$') {
-		format = formatEnd+1;
+	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+	    value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */
+	    if (*end == '$') {
+		format = end+1;
 		format += Tcl_UtfToUniChar(format, &ch);
 		objIndex = (int) value - 1;
 	    }
@@ -678,8 +686,8 @@ Tcl_ScanObjCmd(
 	 * Parse any width specifier.
 	 */
 
-	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
-	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
+	if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */
+	    width = strtoul(format-1, &format, 10); /* INTL: "C" locale. */
 	    format += Tcl_UtfToUniChar(format, &ch);
 	} else {
 	    width = 0;
@@ -691,12 +699,6 @@ Tcl_ScanObjCmd(
 
 	switch (ch) {
 	case 'l':
-	    if (*format == 'l') {
-		flags |= SCAN_BIG;
-		format += 1;
-		format += Tcl_UtfToUniChar(format, &ch);
-		break;
-	    }
 	case 'L':
 	    flags |= SCAN_LONGER;
 	    /*
@@ -711,75 +713,90 @@ Tcl_ScanObjCmd(
 	 */
 
 	switch (ch) {
-	case 'n':
-	    if (!(flags & SCAN_SUPPRESS)) {
-		objPtr = Tcl_NewIntObj(string - baseString);
-		Tcl_IncrRefCount(objPtr);
-		CLANG_ASSERT(objs);
-		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';
-	    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 'b':
-	    op = 'i';
-	    parseFlag |= TCL_PARSE_BINARY_ONLY;
-	    break;
-	case 'u':
-	    op = 'i';
-	    parseFlag |= TCL_PARSE_DECIMAL_ONLY;
-	    flags |= SCAN_UNSIGNED;
-	    break;
+	    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 '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)) {
@@ -799,225 +816,373 @@ Tcl_ScanObjCmd(
 	/*
 	 * 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 = ~0;
-	    }
-	    end = string;
-	    while (*end != '\0') {
-		offset = Tcl_UtfToUniChar(end, &sch);
-		if (Tcl_UniCharIsSpace(sch)) {
-		    break;
+		if (width == 0) {
+		    width = (size_t) ~0;
 		}
-		end += offset;
-		if (--width == 0) {
-		    break;
+		end = string;
+		while (*end != '\0') {
+		    offset = Tcl_UtfToUniChar(end, &sch);
+		    if (Tcl_UniCharIsSpace(sch)) {
+			break;
+		    }
+		    end += offset;
+		    if (--width == 0) {
+			break;
+		    }
 		}
-	    }
-	    if (!(flags & SCAN_SUPPRESS)) {
-		objPtr = Tcl_NewStringObj(string, end-string);
-		Tcl_IncrRefCount(objPtr);
-		CLANG_ASSERT(objs);
-		objs[objIndex++] = objPtr;
-	    }
-	    string = end;
-	    break;
+		if (!(flags & SCAN_SUPPRESS)) {
+		    objPtr = Tcl_NewStringObj(string, end-string);
+		    Tcl_IncrRefCount(objPtr);
+		    objs[objIndex++] = objPtr;
+		}
+		string = end;
+		break;
 
-	case '[': {
-	    CharSet cset;
+	    case '[': {
+		CharSet cset;
 
-	    if (width == 0) {
-		width = ~0;
-	    }
-	    end = string;
+		if (width == 0) {
+		    width = (size_t) ~0;
+		}
+		end = string;
 
-	    format = BuildCharSet(&cset, format);
-	    while (*end != '\0') {
-		offset = Tcl_UtfToUniChar(end, &sch);
-		if (!CharInSet(&cset, (int)sch)) {
-		    break;
+		format = BuildCharSet(&cset, format);
+		while (*end != '\0') {
+		    offset = Tcl_UtfToUniChar(end, &sch);
+		    if (!CharInSet(&cset, (int)sch)) {
+			break;
+		    }
+		    end += offset;
+		    if (--width == 0) {
+			break;
+		    }
 		}
-		end += offset;
-		if (--width == 0) {
-		    break;
+		ReleaseCharSet(&cset);
+
+		if (string == end) {
+		    /*
+		     * 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;
+		
+		break;
 	    }
-	    ReleaseCharSet(&cset);
-
-	    if (string == end) {
+	    case 'c':
 		/*
-		 * Nothing matched the range, stop processing.
+		 * Scan a single Unicode character.
 		 */
-		goto done;
-	    }
-	    if (!(flags & SCAN_SUPPRESS)) {
-		objPtr = Tcl_NewStringObj(string, end-string);
-		Tcl_IncrRefCount(objPtr);
-		objs[objIndex++] = objPtr;
-	    }
-	    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;
 
-	    string += Tcl_UtfToUniChar(string, &sch);
-	    if (!(flags & SCAN_SUPPRESS)) {
-		objPtr = Tcl_NewIntObj((int)sch);
-		Tcl_IncrRefCount(objPtr);
-		CLANG_ASSERT(objs);
-		objs[objIndex++] = objPtr;
-	    }
-	    break;
+	    case 'i':
+		/*
+		 * Scan an unsigned or signed integer.
+		 */
 
-	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;
+		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;
 		    }
-		} else {
-		    if (end == string + width) {
-			underflow = 1;
+
+		    /*
+		     * We got an illegal character so we are done accumulating.
+		     */
+
+		    break;
+
+		    addToInt:
+		    /*
+		     * Add the character to the temporary buffer.
+		     */
+
+		    *end++ = *string++;
+		    if (*string == '\0') {
+			break;
 		    }
 		}
-		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 */
+
+		/*
+		 * 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') {
+			underflow = 1;
 		    }
+		    goto done;
+		} else if (end[-1] == 'x' || end[-1] == 'X') {
+		    end--;
+		    string--;
 		}
-		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);
-		}
-	    } else if (!(flags & SCAN_BIG)) {
-		if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
-		    if (TclGetString(objPtr)[0] == '-') {
-			value = LONG_MIN;
+
+
+		/*
+		 * 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 {
-			value = LONG_MAX;
+#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
 		    }
+#endif
+		    Tcl_IncrRefCount(objPtr);
+		    objs[objIndex++] = objPtr;
 		}
-		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;
 
-	case 'f':
-	    /*
-	     * Scan a floating point number
-	     */
+		break;
 
-	    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;
+	    case 'f':
+		/*
+		 * Scan a floating point number
+		 */
+
+		if ((width == 0) || (width > sizeof(buf) - 1)) {
+		    width = sizeof(buf) - 1;
+		}
+		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;
 		    }
-		} else {
-		    if (end == string + width) {
-			underflow = 1;
+
+		    /*
+		     * 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;
 		    }
 		}
-		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);
+
+		/*
+		 * Check to see if we need to back up because we saw a
+		 * trailing 'e' or sign.
+		 */
+
+		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;
 		    }
+
+		    /*
+		     * We got a bad exponent ('e' and maybe a sign).
+		     */
+
+		    end--;
+		    string--;
+		    if (*end != 'e' && *end != 'E') {
+			end--;
+			string--;
+		    }
 		}
-		Tcl_SetDoubleObj(objPtr, dvalue);
-		CLANG_ASSERT(objs);
-		objs[objIndex++] = objPtr;
-		string = end;
-	    }
+
+		/*
+		 * 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;
+		}
+		break;
 	}
 	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) {
-		continue;
-	    }
-	    result++;
-
-	    /*
-	     * In case of multiple errors in setting variables, just report
-	     * the first one.
-	     */
-
-	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i],
-		    (code == TCL_OK) ? TCL_LEAVE_ERR_MSG : 0) == NULL) {
-		code = TCL_ERROR;
+	    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;
+		}
 	    }
-	    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) {
@@ -1025,16 +1190,15 @@ Tcl_ScanObjCmd(
 		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());
 	    }
 	}
     }
     if (objs != NULL) {
-	ckfree(objs);
+	ckfree((char*) objs);
     }
     if (code == TCL_OK) {
 	if (underflow && (nconversions == 0)) {
@@ -1054,11 +1218,3 @@ Tcl_ScanObjCmd(
     }
     return code;
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
deleted file mode 100755
index 332cfca..0000000
--- a/generic/tclStrToD.c
+++ /dev/null
@@ -1,5018 +0,0 @@
-/*
- * 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
-
-/*
- * Rounding controls. (Thanks a lot, Intel!)
- */
-
-#ifdef __i386
-/*
- * 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__)
-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
-#define TCL_IEEE_DOUBLE_ROUNDING \
-    fpu_control_t roundTo53Bits = FPU_IEEE_ROUNDING;	\
-    fpu_control_t oldRoundingMode;			\
-    _FPU_GETCW(oldRoundingMode);			\
-    _FPU_SETCW(roundTo53Bits)
-#define TCL_DEFAULT_DOUBLE_ROUNDING \
-    _FPU_SETCW(oldRoundingMode)
-
-/*
- * Sun ProC needs sunmath for rounding control on x86 like gcc above.
- */
-#elif defined(__sun)
-#include <sunmath.h>
-#define TCL_IEEE_DOUBLE_ROUNDING \
-    ieee_flags("set","precision","double",NULL)
-#define TCL_DEFAULT_DOUBLE_ROUNDING \
-    ieee_flags("clear","precision",NULL,NULL)
-
-/*
- * Other platforms are assumed to always operate in full IEEE mode, so we make
- * the macros to go in and out of that mode do nothing.
- */
-
-#else /* !__GNUC__ && !__sun */
-#define TCL_IEEE_DOUBLE_ROUNDING	((void) 0)
-#define TCL_DEFAULT_DOUBLE_ROUNDING	((void) 0)
-#endif
-#else /* !__i386 */
-#define TCL_IEEE_DOUBLE_ROUNDING	((void) 0)
-#define TCL_DEFAULT_DOUBLE_ROUNDING	((void) 0)
-#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 int mantDIGIT;		/* Number of mp_digit's needed to hold the
-				 * significand of 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);
-#ifdef IEEE_FLOATING_POINT
-static double		MakeNaN(int signum, Tcl_WideUInt tag);
-#endif
-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(const mp_int *big, int *machexp);
-static double		Pow10TimesFrExp(int exponent, double fraction,
-			    int *machexp);
-static double		SafeLdExp(double fraction, int exponent);
-#ifdef IEEE_FLOATING_POINT
-static Tcl_WideUInt	Nokia770Twiddle(Tcl_WideUInt w);
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * 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_BINARY_ONLY) {
-		goto zerob;
-	    } 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 (flags & TCL_PARSE_BINARY_ONLY) {
-		goto zerob;
-	    }
-	    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:
-	zerob:
-	    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 = Tcl_ObjPrintf("expected %s but got \"",
-		    expected);
-
-	    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.
-     */
-
-    TCL_IEEE_DOUBLE_ROUNDING;
-
-    /*
-     * 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.
-     */
-
-    TCL_DEFAULT_DOUBLE_ROUNDING;
-
-    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.
-     */
-
-    TCL_IEEE_DOUBLE_ROUNDING;
-
-    /*
-     * 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.
-     */
-
-    TCL_DEFAULT_DOUBLE_ROUNDING;
-
-    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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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'.  The string returned
- *	must be freed by the caller using 'ckfree'.
- *
- * Side effects:
- *	Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating
- *	NUL byte of the string if 'endPtr' is not NULL.
- *
- *----------------------------------------------------------------------
- */
-
-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 misguessed
-				 * 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 denominator. */
-	    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);
-	    }
-	    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 ground. */
-    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);
-		}
-		break;
-	    }
-	}
-    }
-    while (*--s == '0') {
-	/* do nothing */
-    }
-    ++s;
-
-    /*
-     * 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 without loss 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, or 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)) {
-	retval = QuickConversion(d.d, k, k_check, flags, i, ilim, ilim1,
-		decpt, endPtr);
-	if (retval != 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 = 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.));
-    mantDIGIT = (mantBits + DIGIT_BIT-1) / DIGIT_BIT;
-    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(pow10_wide);
-    for (i=0; i<9; ++i) {
-	mp_clear(pow5 + i);
-    }
-    for (i=0; i < 5; ++i) {
-	mp_clear(pow5_13 + 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(
-    const 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(
-    const 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(
-    const 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(
-    const 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.
- *
- *----------------------------------------------------------------------
- */
-#ifdef IEEE_FLOATING_POINT
-static Tcl_WideUInt
-Nokia770Twiddle(
-    Tcl_WideUInt w)		/* Number to transpose. */
-{
-    return (((w >> 32) & 0xffffffff) | (w << 32));
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * 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 04cf4ee..8dba3c1 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1,149 +1,134 @@
-/*
+/* 
  * tclStringObj.c --
  *
- *	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
+ *	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
  *	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"
 
 /*
- * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
- * This is an escape hatch in case the changes have some unexpected unwelcome
- * impact on performance. If things go well, this mechanism can go away when
- * post-8.6 development begins.
+ * Prototypes for procedures defined later in this file:
  */
 
-#define COMPAT 0
-
-/*
- * Prototypes for functions defined later in this file:
- */
-
-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 int		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
-			    const Tcl_UniChar *unicode, int numChars);
-static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
-			    const char *bytes, int numBytes,
-			    int numAppendChars);
-static void		FillUnicodeRep(Tcl_Obj *objPtr);
-static void		FreeStringInternalRep(Tcl_Obj *objPtr);
-static void		GrowStringBuffer(Tcl_Obj *objPtr, int needed, int flag);
-static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
-static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+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		SetUnicodeObj(Tcl_Obj *objPtr,
-			    const Tcl_UniChar *unicode, int numChars);
-static int		UnicodeLength(const Tcl_UniChar *unicode);
-static void		UpdateStringOfString(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));
 
 /*
  * The structure below defines the string Tcl object type by means of
- * functions that can be invoked by generic object code.
+ * procedures that can be invoked by generic object code.
  */
 
-const Tcl_ObjType tclStringType = {
-    "string",			/* name */
-    FreeStringInternalRep,	/* freeIntRepPro */
-    DupStringInternalRep,	/* dupIntRepProc */
-    UpdateStringOfString,	/* updateStringProc */
-    SetStringFromAny		/* setFromAnyProc */
+Tcl_ObjType tclStringType = {
+    "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.
- *
- * 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!
+ * 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.
  */
 
 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. */
-    int allocated;		/* The amount of space actually allocated for
-				 * the UTF string (minus 1 byte for the
-				 * termination char). */
-    int maxChars;		/* Max number of chars that can fit in the
-				 * space allocated for the unicode array. */
-    int hasUnicode;		/* Boolean determining whether the string has
-				 * a Unicode representation. */
-    Tcl_UniChar unicode[1];	/* The array of Unicode chars. The actual size
-				 * of this field depends on the 'maxChars'
-				 * 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 \
-	(int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar))
-#define STRING_SIZE(numChars) \
-	(sizeof(String) + ((numChars) * sizeof(Tcl_UniChar)))
+	(1 + (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)))
+#define STRING_UALLOC(numChars)	\
+	((numChars) * sizeof(Tcl_UniChar))
+#define STRING_SIZE(ualloc) \
+    ((unsigned) ((ualloc) \
+	? (sizeof(String) - sizeof(Tcl_UniChar) + (ualloc)) \
+	: sizeof(String)))
 #define stringCheckLimits(numChars) \
-    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
+    if ((unsigned)(numChars) > (unsigned)(STRING_MAXCHARS)) { \
 	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
 		STRING_MAXCHARS); \
     }
-#define stringAttemptAlloc(numChars) \
-	(String *) attemptckalloc((unsigned) STRING_SIZE(numChars) )
-#define stringAlloc(numChars) \
-	(String *) ckalloc((unsigned) STRING_SIZE(numChars) )
 #define stringRealloc(ptr, numChars) \
-    (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
+	(String *) ckrealloc((char *) ptr, \
+		(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
 #define stringAttemptRealloc(ptr, numChars) \
-    (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars) )
+	(String *) attemptckrealloc((char *) ptr, \
+		(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
 #define GET_STRING(objPtr) \
-	((String *) (objPtr)->internalRep.otherValuePtr)
+		((String *) (objPtr)->internalRep.otherValuePtr)
 #define SET_STRING(objPtr, stringPtr) \
-	((objPtr)->internalRep.otherValuePtr = (void *) (stringPtr))
-
+		(objPtr)->internalRep.otherValuePtr = (VOID *) (stringPtr)
+
 /*
  * TCL STRING GROWTH ALGORITHM
  *
@@ -152,106 +137,51 @@ typedef struct String {
  *
  *   Attempt to allocate 2 * (originalLength + appendLength)
  *   On failure:
- *	attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH
+ *	attempt to allocate originalLength + 2*appendLength +
+ *			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_MIN_GROWTH 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_MIN_GROWTH 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_MIN_GROWTH		Additional space, in bytes, to allocate when
- *				the double allocation has failed. Default is
- *				1024 (1 kilobyte).  See tclInt.h.
+ * TCL_GROWTH_MIN_ALLOC		Additional space, in bytes, to allocate when
+ *				the double allocation has failed.
+ *				Default is 1024 (1 kilobyte).
  */
-
-#ifndef TCL_MIN_UNICHAR_GROWTH
-#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
+#ifndef TCL_GROWTH_MIN_ALLOC
+#define TCL_GROWTH_MIN_ALLOC	1024
 #endif
 
 static void
-GrowStringBuffer(
-    Tcl_Obj *objPtr,
-    int needed,
-    int flag)
-{
-    /*
-     * Pre-conditions: 
-     *	objPtr->typePtr == &tclStringType
-     *	needed > stringPtr->allocated
-     *	flag || objPtr->bytes != NULL
-     */
-
-    String *stringPtr = GET_STRING(objPtr);
-    char *ptr = NULL;
-    int attempt;
-
-    if (objPtr->bytes == tclEmptyStringRep) {
-	objPtr->bytes = NULL;
-    }
-    if (flag == 0 || stringPtr->allocated > 0) {
-	attempt = 2 * needed;
-	if (attempt >= 0) {
-	    ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
-	}
-	if (ptr == NULL) {
-	    /*
-	     * Take care computing the amount of modest growth to avoid
-	     * overflow into invalid argument values for attempt.
-	     */
-
-	    unsigned int limit = INT_MAX - needed;
-	    unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
-	    int growth = (int) ((extra > limit) ? limit : extra);
-
-	    attempt = needed + growth;
-	    ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
-	}
-    }
-    if (ptr == NULL) {
-	/*
-	 * First allocation - just big enough; or last chance fallback.
-	 */
-
-	attempt = needed;
-	ptr = ckrealloc(objPtr->bytes, attempt + 1);
-    }
-    objPtr->bytes = ptr;
-    stringPtr->allocated = attempt;
-}
-
-static void
 GrowUnicodeBuffer(
     Tcl_Obj *objPtr,
     int needed)
 {
-    /*
-     * Pre-conditions: 
-     *	objPtr->typePtr == &tclStringType
-     *	needed > stringPtr->maxChars
-     *	needed < STRING_MAXCHARS
+    /* Pre-conditions:
+     *  objPtr->typePtr == &tclStringType
+     *  STRING_UALLOC(needed) > stringPtr->uallocated
+     *  needed < STRING_MAXCHARS
      */
-
     String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
     int attempt;
 
-    if (stringPtr->maxChars > 0) {
-	/*
-	 * Subsequent appends - apply the growth algorithm.
-	 */
-
+    if (stringPtr->uallocated > 0) {
+	/* Subsequent appends - apply the growth algorithm. */
 	attempt = 2 * needed;
 	if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
 	    ptr = stringAttemptRealloc(stringPtr, attempt);
@@ -261,83 +191,84 @@ GrowUnicodeBuffer(
 	     * Take care computing the amount of modest growth to avoid
 	     * overflow into invalid argument values for attempt.
 	     */
-
 	    unsigned int limit = STRING_MAXCHARS - needed;
 	    unsigned int extra = needed - stringPtr->numChars
-		    + TCL_MIN_UNICHAR_GROWTH;
+		    + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
 	    int growth = (int) ((extra > limit) ? limit : extra);
-
 	    attempt = needed + growth;
 	    ptr = stringAttemptRealloc(stringPtr, attempt);
 	}
     }
     if (ptr == NULL) {
-	/*
-	 * First allocation - just big enough; or last chance fallback.
-	 */
-
+	/* First allocation - just big enough; or last chance fallback. */
 	attempt = needed;
 	ptr = stringRealloc(stringPtr, attempt);
     }
     stringPtr = ptr;
-    stringPtr->maxChars = attempt;
+    stringPtr->uallocated = STRING_UALLOC(attempt);
     SET_STRING(objPtr, stringPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_NewStringObj --
  *
- *	This function is normally called when not debugging: i.e., when
+ *	This procedure 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 function just returns the result
- *	of calling the debugging version Tcl_DbNewStringObj.
+ *	When TCL_MEM_DEBUG is defined, this procedure 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 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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 #ifdef TCL_MEM_DEBUG
 #undef Tcl_NewStringObj
+
 Tcl_Obj *
-Tcl_NewStringObj(
-    const char *bytes,		/* Points to the first of the length bytes
+Tcl_NewStringObj(bytes, length)
+    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 NUL
-				 * byte. */
+    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. */
 {
     return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
 }
+
 #else /* if not TCL_MEM_DEBUG */
+
 Tcl_Obj *
-Tcl_NewStringObj(
-    const char *bytes,		/* Points to the first of the length bytes
+Tcl_NewStringObj(bytes, length)
+    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 NUL
-				 * byte. */
+    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. */
 {
-    Tcl_Obj *objPtr;
+    register Tcl_Obj *objPtr;
 
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
     }
-    TclNewStringObj(objPtr, bytes, length);
+    TclNewObj(objPtr);
+    TclInitStringRep(objPtr, bytes, length);
     return objPtr;
 }
 #endif /* TCL_MEM_DEBUG */
@@ -347,45 +278,47 @@ Tcl_NewStringObj(
  *
  * Tcl_DbNewStringObj --
  *
- *	This function is normally called when debugging: i.e., when
+ *	This procedure 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 function above except that it calls
+ *	same as the Tcl_NewStringObj 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 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 function just returns the
+ *	When TCL_MEM_DEBUG is not defined, this procedure 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 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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 #ifdef TCL_MEM_DEBUG
+
 Tcl_Obj *
-Tcl_DbNewStringObj(
-    const char *bytes,		/* Points to the first of the length bytes
+Tcl_DbNewStringObj(bytes, length, file, line)
+    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 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. */
+    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. */
 {
-    Tcl_Obj *objPtr;
+    register Tcl_Obj *objPtr;
 
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
@@ -394,19 +327,21 @@ Tcl_DbNewStringObj(
     TclInitStringRep(objPtr, bytes, length);
     return objPtr;
 }
+
 #else /* if not TCL_MEM_DEBUG */
+
 Tcl_Obj *
-Tcl_DbNewStringObj(
-    const char *bytes,		/* Points to the first of the length bytes
+Tcl_DbNewStringObj(bytes, length, file, line)
+    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 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 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. */
 {
     return Tcl_NewStringObj(bytes, length);
 }
@@ -417,13 +352,14 @@ Tcl_DbNewStringObj(
  *
  * Tcl_NewUnicodeObj --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -432,10 +368,10 @@ Tcl_DbNewStringObj(
  */
 
 Tcl_Obj *
-Tcl_NewUnicodeObj(
-    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
-				 * new object. */
-    int numChars)		/* Number of characters in the unicode
+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
 				 * string. */
 {
     Tcl_Obj *objPtr;
@@ -456,62 +392,73 @@ Tcl_NewUnicodeObj(
  *	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(
-    Tcl_Obj *objPtr)		/* The String object to get the num chars
-				 * of. */
+Tcl_GetCharLength(objPtr)
+    Tcl_Obj *objPtr;	/* The String object to get the num chars of. */
 {
     String *stringPtr;
-    int numChars;
+    
+    SetStringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
 
     /*
-     * Optimize the case where we're really dealing with a bytearray object
-     * without string representation; we don't need to convert to a string to
-     * perform the get-length operation.
+     * 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;
 
-    if (TclIsPureByteArray(objPtr)) {
-	int length;
-
-	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
-	return length;
-    }
-
-    /*
-     * OK, need to work with the object as a string.
-     */
+	/*
+	 * 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);
+	*/
+
+	while (i && (*str < 0xC0)) { i--; str++; }
+	stringPtr->numChars = objPtr->length - i;
+	if (i) {
+	    stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
+		    + (objPtr->length - i), i);
+	}
 
-    SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(objPtr);
-    numChars = stringPtr->numChars;
+ 	if (stringPtr->numChars == objPtr->length) {
 
-    /*
-     * If numChars is unknown, compute it.
-     */
+	    /*
+	     * 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.
+	     */
 
-    if (numChars == -1) {
-	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
-	stringPtr->numChars = numChars;
+	    stringPtr->hasUnicode = 0;
 
-#if COMPAT
-	if (numChars < objPtr->length) {
+	} else {
+    
 	    /*
-	     * Since we've just computed 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);
+
+	    /*
+	     * 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);
 	}
-#endif
     }
-    return numChars;
+    return stringPtr->numChars;
 }
 
 /*
@@ -519,8 +466,8 @@ Tcl_GetCharLength(
  *
  * 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.
@@ -532,47 +479,46 @@ Tcl_GetCharLength(
  */
 
 Tcl_UniChar
-Tcl_GetUniChar(
-    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
-				 * from. */
-    int index)			/* Get the index'th Unicode character. */
+Tcl_GetUniChar(objPtr, index)
+    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);
 
-    /*
-     * Optimize the case where we're really dealing with a bytearray object
-     * without string representation; we don't need to convert to a string to
-     * perform the indexing operation.
-     */
-
-    if (TclIsPureByteArray(objPtr)) {
-	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
-
-	return (Tcl_UniChar) bytes[index];
-    }
+    if (stringPtr->numChars == -1) {
 
-    /*
-     * OK, need to work with the object as a string.
-     */
+	/*
+	 * 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.
+	 */
 
-    SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(objPtr);
+	Tcl_GetCharLength(objPtr);
 
+	/*
+	 * We need to fetch the pointer again because we may have just
+	 * reallocated the structure.
+	 */
+	
+	stringPtr = GET_STRING(objPtr);
+    }
     if (stringPtr->hasUnicode == 0) {
+
 	/*
-	 * If numChars is unknown, compute it.
+	 * 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.
 	 */
 
-	if (stringPtr->numChars == -1) {
-	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
-	}
-	if (stringPtr->numChars == objPtr->length) {
-	    return (Tcl_UniChar) objPtr->bytes[index];
-	}
-	FillUnicodeRep(objPtr);
-	stringPtr = GET_STRING(objPtr);
+	unichar = (Tcl_UniChar) objPtr->bytes[index];
+    } else {
+	unichar = stringPtr->unicode[index];
     }
-    return stringPtr->unicode[index];
+    return unichar;
 }
 
 /*
@@ -580,10 +526,10 @@ Tcl_GetUniChar(
  *
  * 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.
@@ -595,11 +541,34 @@ Tcl_GetUniChar(
  */
 
 Tcl_UniChar *
-Tcl_GetUnicode(
-    Tcl_Obj *objPtr)		/* The object to find the unicode string
-				 * for. */
+Tcl_GetUnicode(objPtr)
+    Tcl_Obj *objPtr;	/* The object to find the unicode string for. */
 {
-    return Tcl_GetUnicodeFromObj(objPtr, NULL);
+    String *stringPtr;
+    
+    SetStringFromAny(NULL, objPtr);
+    stringPtr = GET_STRING(objPtr);
+    
+    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.
+	 */
+
+	FillUnicodeRep(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);
+    }
+    return stringPtr->unicode;
 }
 
 /*
@@ -607,10 +576,10 @@ Tcl_GetUnicode(
  *
  * 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.
@@ -622,20 +591,34 @@ Tcl_GetUnicode(
  */
 
 Tcl_UniChar *
-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. */
+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. */
 {
     String *stringPtr;
-
+    
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
+    
+    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.
+	 */
 
-    if (stringPtr->hasUnicode == 0) {
 	FillUnicodeRep(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);
     }
 
@@ -650,10 +633,10 @@ Tcl_GetUnicodeFromObj(
  *
  * 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.
@@ -665,58 +648,59 @@ Tcl_GetUnicodeFromObj(
  */
 
 Tcl_Obj *
-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_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_Obj *newObjPtr;		/* The Tcl object to find the range of. */
     String *stringPtr;
-
-    /*
-     * Optimize the case where we're really dealing with a bytearray object
-     * without string representation; we don't need to convert to a string to
-     * perform the substring operation.
-     */
-
-    if (TclIsPureByteArray(objPtr)) {
-	unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
-
-	return Tcl_NewByteArrayObj(bytes+first, last-first+1);
-    }
-
-    /*
-     * OK, need to work with the object as a string.
-     */
-
+    
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
 
-    if (stringPtr->hasUnicode == 0) {
+    if (stringPtr->numChars == -1) {
+    
 	/*
-	 * If numChars is unknown, compute it.
+	 * 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.
 	 */
 
-	if (stringPtr->numChars == -1) {
-	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
-	}
-	if (stringPtr->numChars == objPtr->length) {
-	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
-
-	    /*
-	     * Since we know the char length of the result, store it.
-	     */
+	Tcl_GetCharLength(objPtr);
 
-	    SetStringFromAny(NULL, newObjPtr);
-	    stringPtr = GET_STRING(newObjPtr);
-	    stringPtr->numChars = newObjPtr->length;
-	    return newObjPtr;
-	}
-	FillUnicodeRep(objPtr);
+	/*
+	 * We need to fetch the pointer again because we may have just
+	 * reallocated the structure.
+	 */
+	
 	stringPtr = GET_STRING(objPtr);
     }
 
-    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
+    if (objPtr->bytes && stringPtr->numChars == objPtr->length) {
+	char *str = Tcl_GetString(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.
+	 */
+	
+	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.
+	 */
+	
+	SetStringFromAny(NULL, newObjPtr);
+	stringPtr = GET_STRING(newObjPtr);
+	stringPtr->numChars = last-first+1;
+    } else {
+	newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
+		last-first+1);
+    }
+    return newObjPtr;
 }
 
 /*
@@ -725,46 +709,52 @@ Tcl_GetRange(
  * 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 NUL byte; i.e., assume "bytes" points to a C-style
- *	NUL-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 NULL byte; i.e., assume "bytes" points to a
+ *	C-style NULL-terminated string. The object's old string and internal
  *	representations are freed and the object's type is set NULL.
  *
  *----------------------------------------------------------------------
  */
 
 void
-Tcl_SetStringObj(
-    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
-    const char *bytes,		/* Points to the first of the length bytes
+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
 				 * used to initialize the object. */
-    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 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 Tcl_ObjType *oldTypePtr = objPtr->typePtr;
+
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
+	panic("Tcl_SetStringObj called with shared object");
     }
 
     /*
      * Set the type to NULL and free any internal rep for the old type.
      */
 
-    TclFreeIntRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(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".
      */
 
-    TclInvalidateStringRep(objPtr);
+    Tcl_InvalidateStringRep(objPtr);
     if (length < 0) {
 	length = (bytes? strlen(bytes) : 0);
     }
@@ -776,29 +766,30 @@ Tcl_SetStringObj(
  *
  * Tcl_SetObjLength --
  *
- *	This function changes the length of the string representation of an
- *	object.
+ *	This procedure 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(
-    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
-				 * currently be shared. */
-    int length)			/* Number of bytes desired for string
+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
 				 * representation of object, not including
 				 * terminating null byte. */
 {
@@ -806,73 +797,71 @@ Tcl_SetObjLength(
 
     if (length < 0) {
 	/*
-	 * Setting to a negative length is nonsense. This is probably the
+	 * Setting to a negative length is nonsense.  This is probably the
 	 * result of overflowing the signed integer range.
 	 */
-
 	Tcl_Panic("Tcl_SetObjLength: negative length requested: "
 		"%d (integer overflow?)", length);
     }
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
-    }
-
-    if (objPtr->bytes && objPtr->length == length) {
-	return;
+	panic("Tcl_SetObjLength called with shared object");
     }
-
     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;
 
-    if (objPtr->bytes != NULL) {
 	/*
-	 * Change length of an existing string rep.
+	 * Not enough space in current string. Reallocate the string
+	 * space and free the old string.
 	 */
-	if (length > stringPtr->allocated) {
-	    /*
-	     * Need to enlarge the buffer.
-	     */
-	    if (objPtr->bytes == tclEmptyStringRep) {
-		objPtr->bytes = ckalloc(length + 1);
-	    } else {
-		objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
+	if (objPtr->bytes != tclEmptyStringRep && objPtr->bytes != NULL) {
+	    new = (char *) ckrealloc((char *)objPtr->bytes,
+		    (unsigned)(length+1));
+	} else {
+	    new = (char *) ckalloc((unsigned) (length+1));
+	    if (objPtr->bytes != NULL && objPtr->length != 0) {
+		memcpy((VOID *) new, (VOID *) objPtr->bytes,
+			(size_t) objPtr->length);
+		Tcl_InvalidateStringRep(objPtr);
 	    }
-	    stringPtr->allocated = length;
 	}
-
-	objPtr->length = length;
-	objPtr->bytes[length] = 0;
-
-	/*
-	 * Invalidate the unicode data.
-	 */
-
-	stringPtr->numChars = -1;
+	objPtr->bytes = new;
+	stringPtr->allocated = length;
+	/* 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;
     } else {
-	/*
-	 * Changing length of pure unicode string.
-	 */
+        /* Changing length of pure unicode string */
+        size_t uallocated = STRING_UALLOC(length);
 
 	stringCheckLimits(length);
-	if (length > stringPtr->maxChars) {
+        if (uallocated > stringPtr->uallocated) {
 	    stringPtr = stringRealloc(stringPtr, length);
-	    SET_STRING(objPtr, stringPtr);
-	    stringPtr->maxChars = length;
-	}
-
-	/*
-	 * Mark the new end of the unicode string
-	 */
-
-	stringPtr->numChars = length;
-	stringPtr->unicode[length] = 0;
-	stringPtr->hasUnicode = 1;
-
-	/*
-	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
-	 * the string rep.
-	 */
+            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;
     }
 }
 
@@ -881,29 +870,30 @@ Tcl_SetObjLength(
  *
  * Tcl_AttemptSetObjLength --
  *
- *	This function changes the length of the string representation of an
- *	object. It uses the attempt* (non-panic'ing) memory allocators.
+ *	This procedure 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(
-    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
-				 * currently be shared. */
-    int length)			/* Number of bytes desired for string
+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
 				 * representation of object, not including
 				 * terminating null byte. */
 {
@@ -911,83 +901,81 @@ Tcl_AttemptSetObjLength(
 
     if (length < 0) {
 	/*
-	 * Setting to a negative length is nonsense. This is probably the
+	 * Setting to a negative length is nonsense.  This is probably the
 	 * result of overflowing the signed integer range.
 	 */
-
 	return 0;
     }
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
-    }
-    if (objPtr->bytes && objPtr->length == length) {
-	return 1;
+	panic("Tcl_AttemptSetObjLength called with shared object");
     }
-
     SetStringFromAny(NULL, objPtr);
+        
     stringPtr = GET_STRING(objPtr);
 
-    if (objPtr->bytes != NULL) {
-	/*
-	 * Change length of an existing string rep.
-	 */
-	if (length > stringPtr->allocated) {
-	    /*
-	     * Need to enlarge the buffer.
-	     */
+    /* Check that we're not extending a pure unicode string */
 
-	    char *newBytes;
+    if (length > (int) stringPtr->allocated && 
+	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
+	char *new;
 
-	    if (objPtr->bytes == tclEmptyStringRep) {
-		newBytes = attemptckalloc(length + 1);
-	    } else {
-		newBytes = attemptckrealloc(objPtr->bytes, length + 1);
+	/*
+	 * 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) {
+		return 0;
 	    }
-	    if (newBytes == NULL) {
+	} else {
+	    new = (char *) attemptckalloc((unsigned) (length+1));
+	    if (new == NULL) {
 		return 0;
 	    }
-	    objPtr->bytes = newBytes;
-	    stringPtr->allocated = length;
+	    if (objPtr->bytes != NULL && objPtr->length != 0) {
+ 	    	memcpy((VOID *) new, (VOID *) objPtr->bytes,
+ 		    	(size_t) objPtr->length);
+ 	    	Tcl_InvalidateStringRep(objPtr);
+	    }
 	}
-
+	objPtr->bytes = new;
+	stringPtr->allocated = length;
+	/* Invalidate the unicode data. */
+	stringPtr->hasUnicode = 0;
+    }
+    
+    if (objPtr->bytes != NULL) {
 	objPtr->length = length;
-	objPtr->bytes[length] = 0;
-
-	/*
-	 * Invalidate the unicode data.
-	 */
-
+	if (objPtr->bytes != tclEmptyStringRep) {
+	    /* Ensure the string is NULL-terminated */
+	    objPtr->bytes[length] = 0;
+	}
+	/* 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;
 	}
-	if (length > stringPtr->maxChars) {
+
+	if (uallocated > stringPtr->uallocated) {
 	    stringPtr = stringAttemptRealloc(stringPtr, length);
 	    if (stringPtr == NULL) {
-		return 0;
+	        return 0;
 	    }
 	    SET_STRING(objPtr, stringPtr);
-	    stringPtr->maxChars = length;
+	    stringPtr->uallocated = uallocated;
 	}
-
-	/*
-	 * Mark the new end of the unicode string.
-	 */
-
-	stringPtr->unicode[length] = 0;
 	stringPtr->numChars = length;
-	stringPtr->hasUnicode = 1;
-
-	/*
-	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
-	 * the string rep.
-	 */
+	stringPtr->hasUnicode = (length > 0);
+	/* Ensure the string is NULL-terminated */
+	stringPtr->unicode[length] = 0;
+	stringPtr->allocated = 0;
+	objPtr->length = 0;
     }
     return 1;
 }
@@ -1009,23 +997,27 @@ Tcl_AttemptSetObjLength(
  */
 
 void
-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
+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
 				 * string. */
 {
+    Tcl_ObjType *typePtr = objPtr->typePtr;
+
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
     }
-    TclFreeIntRep(objPtr);
+    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	typePtr->freeIntRepProc(objPtr);
+    }
     SetUnicodeObj(objPtr, unicode, numChars);
 }
 
 static int
 UnicodeLength(
-    const Tcl_UniChar *unicode)
+    CONST Tcl_UniChar *unicode)
 {
     int numChars = 0;
 
@@ -1039,14 +1031,15 @@ UnicodeLength(
 }
 
 static void
-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
+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
 				 * string. */
 {
     String *stringPtr;
+    size_t uallocated;
 
     if (numChars < 0) {
 	numChars = UnicodeLength(unicode);
@@ -1055,60 +1048,56 @@ SetUnicodeObj(
     /*
      * Allocate enough space for the String structure + Unicode string.
      */
-
+	
     stringCheckLimits(numChars);
-    stringPtr = stringAlloc(numChars);
-    SET_STRING(objPtr, stringPtr);
-    objPtr->typePtr = &tclStringType;
+    uallocated = STRING_UALLOC(numChars);
+    stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));
 
-    stringPtr->maxChars = numChars;
-    memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
-    stringPtr->unicode[numChars] = 0;
     stringPtr->numChars = numChars;
-    stringPtr->hasUnicode = 1;
-
-    TclInvalidateStringRep(objPtr);
+    stringPtr->uallocated = uallocated;
+    stringPtr->hasUnicode = (numChars > 0);
     stringPtr->allocated = 0;
+    memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
+    stringPtr->unicode[numChars] = 0;
+
+    Tcl_InvalidateStringRep(objPtr);
+    objPtr->typePtr = &tclStringType;
+    SET_STRING(objPtr, stringPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AppendLimitedToObj --
+ * Tcl_AppendToObj --
  *
- *	This function appends a limited number of bytes from a sequence of
- *	bytes to an object, marking any limitation with an ellipsis.
+ *	This procedure appends a sequence of bytes to an object.
  *
  * 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_AppendLimitedToObj(
-    Tcl_Obj *objPtr,		/* Points to the object to append to. */
-    const char *bytes,		/* Points to the bytes to append to the
+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
 				 * object. */
-    int length,			/* The number of bytes available to be
-				 * appended from "bytes". If < 0, then all
-				 * bytes up to a NUL byte are available. */
-    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. */
+    register int length;	/* The number of bytes to append from
+				 * "bytes". If < 0, then append all bytes
+				 * up to NULL byte. */
 {
     String *stringPtr;
-    int toCopy = 0;
 
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
+	panic("Tcl_AppendToObj called with shared object");
     }
+    
+    SetStringFromAny(NULL, objPtr);
 
     if (length < 0) {
 	length = (bytes ? strlen(bytes) : 0);
@@ -1117,78 +1106,29 @@ Tcl_AppendLimitedToObj(
 	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.
      */
 
-    SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
+    if (stringPtr->hasUnicode != 0) {
+	AppendUtfToUnicodeRep(objPtr, bytes, length);
 
-    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
-	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
-    } else {
-	AppendUtfToUtfRep(objPtr, bytes, toCopy);
-    }
-
-    if (length <= limit) {
-	return;
-    }
-
-    stringPtr = GET_STRING(objPtr);
-    if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
-	AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
+	stringPtr = GET_STRING(objPtr);
     } else {
-	AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
+	AppendUtfToUtfRep(objPtr, bytes, length);
     }
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * 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(
-    Tcl_Obj *objPtr,		/* Points to the object to append to. */
-    const char *bytes,		/* Points to the bytes to append to the
-				 * object. */
-    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 function appends a Unicode string to an object in the most
- *	efficient manner possible. Length must be >= 0.
+ *	This procedure appends a Unicode string to an object in the
+ *	most efficient manner possible.  Length must be >= 0.
  *
  * Results:
  *	None.
@@ -1200,16 +1140,16 @@ Tcl_AppendToObj(
  */
 
 void
-Tcl_AppendUnicodeToObj(
-    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(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". */
 {
     String *stringPtr;
 
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
+	panic("Tcl_AppendUnicodeToObj called with shared object");
     }
 
     if (length == 0) {
@@ -1220,16 +1160,12 @@ Tcl_AppendUnicodeToObj(
     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
-#if COMPAT
-		&& stringPtr->numChars > 0
-#endif
-	    ) {
+    if (stringPtr->hasUnicode != 0) {
 	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
     } else {
 	AppendUnicodeToUtfRep(objPtr, unicode, length);
@@ -1241,121 +1177,87 @@ Tcl_AppendUnicodeToObj(
  *
  * Tcl_AppendObjToObj --
  *
- *	This function appends the string rep of one object to another.
+ *	This procedure 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(
-    Tcl_Obj *objPtr,		/* Points to the object to append to. */
-    Tcl_Obj *appendObjPtr)	/* Object to append. */
+Tcl_AppendObjToObj(objPtr, appendObjPtr)
+    Tcl_Obj *objPtr;		/* Points to the object to append to. */
+    Tcl_Obj *appendObjPtr;	/* Object to append. */
 {
     String *stringPtr;
-    int length, numChars, appendNumChars = -1;
-    const char *bytes;
-
-    /*
-     * Special case: second object is standard-empty is fast case. We know
-     * that appending nothing to anything leaves that starting anything...
-     */
-
-    if (appendObjPtr->bytes == tclEmptyStringRep) {
-	return;
-    }
-
-    /*
-     * Handle append of one bytearray object to another as a special case.
-     * Note that we only do this when the objects don't have string reps; if
-     * it did, then appending the byte arrays together could well lose
-     * information; this is a special-case optimization only.
-     */
-
-    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
-	    && TclIsPureByteArray(appendObjPtr)) {
-	unsigned char *bytesSrc;
-	int lengthSrc, lengthTotal;
-
-	/*
-	 * We do not assume that objPtr and appendObjPtr must be distinct!
-	 * This makes this code a bit more complex than it otherwise would be,
-	 * but in turn makes it much safer.
-	 */
-
-	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
-	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
-	lengthTotal = length + lengthSrc;
-	if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
-	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
-	}
-	bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
-	TclAppendBytesToByteArray(objPtr, bytesSrc, lengthSrc);
-	return;
-    }
-
-    /*
-     * Must append as strings.
-     */
+    int length, numChars, allOneByteChars;
+    char *bytes;
 
     SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(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.
      */
 
-    if (stringPtr->hasUnicode 
-#if COMPAT
-		&& stringPtr->numChars > 0
-#endif
-	    ) {
+    stringPtr = GET_STRING(objPtr);
+    if (stringPtr->hasUnicode != 0) {
+	
 	/*
 	 * If appendObjPtr is not of the "String" type, don't convert it.
 	 */
 
 	if (appendObjPtr->typePtr == &tclStringType) {
-	    Tcl_UniChar *unicode =
-		    Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
+	    stringPtr = GET_STRING(appendObjPtr);
+	    if ((stringPtr->numChars == -1)
+		    || (stringPtr->hasUnicode == 0)) {
+		
+		/*
+		 * If appendObjPtr is a string obj with no valid Unicode
+		 * rep, then fill its unicode rep.
+		 */
 
-	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
+		FillUnicodeRep(appendObjPtr);
+		stringPtr = GET_STRING(appendObjPtr);
+	    }
+	    AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
+		    stringPtr->numChars);
 	} else {
-	    bytes = TclGetStringFromObj(appendObjPtr, &length);
+	    bytes = Tcl_GetStringFromObj(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 = TclGetStringFromObj(appendObjPtr, &length);
+    bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
 
+    allOneByteChars = 0;
     numChars = stringPtr->numChars;
     if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
-	String *appendStringPtr = GET_STRING(appendObjPtr);
-	appendNumChars = appendStringPtr->numChars;
+	stringPtr = GET_STRING(appendObjPtr);
+	if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
+	    numChars += stringPtr->numChars;
+	    allOneByteChars = 1;
+	}
     }
 
     AppendUtfToUtfRep(objPtr, bytes, length);
 
-    if (numChars >= 0 && appendNumChars >= 0
-#if COMPAT
-		&& appendNumChars == length
-#endif
-	    ) {
-	stringPtr->numChars = numChars + appendNumChars;
+    if (allOneByteChars) {
+	stringPtr = GET_STRING(objPtr);
+	stringPtr->numChars = numChars;
     }
 }
 
@@ -1364,8 +1266,8 @@ Tcl_AppendObjToObj(
  *
  * AppendUnicodeToUnicodeRep --
  *
- *	This function appends the contents of "unicode" to the Unicode rep of
- *	"objPtr". objPtr must already have a valid Unicode rep.
+ *	This procedure appends the contents of "unicode" to the Unicode
+ *	rep of "objPtr".  objPtr must already have a valid Unicode rep.
  *
  * Results:
  *	None.
@@ -1377,13 +1279,13 @@ Tcl_AppendObjToObj(
  */
 
 static void
-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. */
+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. */
 {
     String *stringPtr;
-    int numChars;
+    size_t numChars;
 
     if (appendNumChars < 0) {
 	appendNumChars = UnicodeLength(unicode);
@@ -1396,37 +1298,32 @@ AppendUnicodeToUnicodeRep(
     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;
     stringCheckLimits(numChars);
 
-    if (numChars > stringPtr->maxChars) {
-	int offset = -1;
-
+    if (STRING_UALLOC(numChars) > stringPtr->uallocated) {
 	/*
 	 * Protect against case where unicode points into the existing
-	 * stringPtr->unicode array. Force it to follow any relocations due to
-	 * the reallocs below.
+	 * stringPtr->unicode array.  Force it to follow any relocations
+	 * due to the reallocs below.
 	 */
-
-	if (unicode >= stringPtr->unicode
-		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
+	int offset = -1;
+	if (unicode >= stringPtr->unicode && unicode <= stringPtr->unicode
+		+ stringPtr->uallocated / sizeof(Tcl_UniChar)) {
 	    offset = unicode - stringPtr->unicode;
 	}
 
 	GrowUnicodeBuffer(objPtr, numChars);
 	stringPtr = GET_STRING(objPtr);
 
-	/*
-	 * Relocate unicode if needed; see above.
-	 */
-
+	/* Relocate unicode if needed; see above. */
 	if (offset >= 0) {
 	    unicode = stringPtr->unicode + offset;
 	}
@@ -1437,13 +1334,13 @@ AppendUnicodeToUnicodeRep(
      * trailing null.
      */
 
-    memmove(stringPtr->unicode + stringPtr->numChars, unicode,
+    memcpy((VOID*) (stringPtr->unicode + stringPtr->numChars), unicode,
 	    appendNumChars * sizeof(Tcl_UniChar));
     stringPtr->unicode[numChars] = 0;
     stringPtr->numChars = numChars;
     stringPtr->allocated = 0;
 
-    TclInvalidateStringRep(objPtr);
+    Tcl_InvalidateStringRep(objPtr);
 }
 
 /*
@@ -1451,8 +1348,8 @@ AppendUnicodeToUnicodeRep(
  *
  * AppendUnicodeToUtfRep --
  *
- *	This function converts the contents of "unicode" to UTF and appends
- *	the UTF to the string rep of "objPtr".
+ *	This procedure converts the contents of "unicode" to UTF and
+ *	appends the UTF to the string rep of "objPtr".
  *
  * Results:
  *	None.
@@ -1464,26 +1361,25 @@ AppendUnicodeToUnicodeRep(
  */
 
 static void
-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. */
+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. */
 {
-    String *stringPtr = GET_STRING(objPtr);
-
-    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
-
-    if (stringPtr->numChars != -1) {
-	stringPtr->numChars += numChars;
+    Tcl_DString dsPtr;
+    CONST char *bytes;
+    
+    if (numChars < 0) {
+	numChars = UnicodeLength(unicode);
+    }
+    if (numChars == 0) {
+	return;
     }
 
-#if COMPAT
-    /*
-     * Invalidate the unicode rep.
-     */
-
-    stringPtr->hasUnicode = 0;
-#endif
+    Tcl_DStringInit(&dsPtr);
+    bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
+    AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
+    Tcl_DStringFree(&dsPtr);
 }
 
 /*
@@ -1491,9 +1387,9 @@ AppendUnicodeToUtfRep(
  *
  * AppendUtfToUnicodeRep --
  *
- *	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. numBytes must be non-negative.
+ *	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.
  *
  * Results:
  *	None.
@@ -1505,21 +1401,27 @@ AppendUnicodeToUtfRep(
  */
 
 static void
-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. */
+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. */
 {
-    String *stringPtr;
+    Tcl_DString dsPtr;
+    int numChars;
+    Tcl_UniChar *unicode;
 
+    if (numBytes < 0) {
+	numBytes = (bytes ? strlen(bytes) : 0);
+    }
     if (numBytes == 0) {
 	return;
     }
-
-    ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1);
-    TclInvalidateStringRep(objPtr);
-    stringPtr = GET_STRING(objPtr);
-    stringPtr->allocated = 0;
+    
+    Tcl_DStringInit(&dsPtr);
+    numChars = Tcl_NumUtfChars(bytes, numBytes);
+    unicode = (Tcl_UniChar *)Tcl_UtfToUniCharDString(bytes, numBytes, &dsPtr);
+    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
+    Tcl_DStringFree(&dsPtr);
 }
 
 /*
@@ -1527,9 +1429,8 @@ AppendUtfToUnicodeRep(
  *
  * AppendUtfToUtfRep --
  *
- *	This function appends "numBytes" bytes of "bytes" to the UTF string
- *	rep of "objPtr". objPtr must already have a valid String rep.
- *	numBytes must be non-negative.
+ *	This procedure appends "numBytes" bytes of "bytes" to the UTF string
+ *	rep of "objPtr".  objPtr must already have a valid String rep.
  *
  * Results:
  *	None.
@@ -1541,14 +1442,17 @@ AppendUtfToUnicodeRep(
  */
 
 static void
-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. */
+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. */
 {
     String *stringPtr;
     int newLength, oldLength;
 
+    if (numBytes < 0) {
+	numBytes = (bytes ? strlen(bytes) : 0);
+    }
     if (numBytes == 0) {
 	return;
     }
@@ -1558,9 +1462,6 @@ AppendUtfToUtfRep(
      * trailing null.
      */
 
-    if (objPtr->bytes == NULL) {
-	objPtr->length = 0;
-    }
     oldLength = objPtr->length;
     newLength = numBytes + oldLength;
     if (newLength < 0) {
@@ -1568,32 +1469,40 @@ AppendUtfToUtfRep(
     }
 
     stringPtr = GET_STRING(objPtr);
-    if (newLength > stringPtr->allocated) {
-	int offset = -1;
-
-	/*
+    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.
+	 * stringPtr->unicode array.  Force it to follow any relocations
+	 * due to the reallocs below.
 	 */
-
+	int offset = -1;
 	if (bytes >= objPtr->bytes
 		&& bytes <= objPtr->bytes + objPtr->length) {
 	    offset = bytes - objPtr->bytes;
 	}
 
 	/*
-	 * TODO: consider passing flag=1: no overalloc on first append. This
-	 * would make test stringObj-8.1 fail.
+	 * 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.
 	 */
 
-	GrowStringBuffer(objPtr, newLength, 0);
+	if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) {
+	    /*
+	     * Take care computing the amount of modest growth to avoid
+	     * overflow into invalid argument values for Tcl_SetObjLength.
+	     */
+	    unsigned int limit = INT_MAX - newLength;
+	    unsigned int extra = numBytes + TCL_GROWTH_MIN_ALLOC;
+	    int growth = (int) ((extra > limit) ? limit : extra);
 
-	/*
-	 * Relocate bytes if needed; see above.
-	 */
+	    Tcl_SetObjLength(objPtr, newLength + growth);
+	}
 
-	if (offset >= 0) {
+	/* Relocate bytes if needed; see above. */
+	if (offset >=0) {
 	    bytes = objPtr->bytes + offset;
 	}
     }
@@ -1601,11 +1510,12 @@ AppendUtfToUtfRep(
     /*
      * Invalidate the unicode data.
      */
-
+    
     stringPtr->numChars = -1;
     stringPtr->hasUnicode = 0;
-
-    memmove(objPtr->bytes + oldLength, bytes, numBytes);
+    
+    memcpy((VOID *) (objPtr->bytes + oldLength), (VOID *) bytes,
+	    (size_t) numBytes);
     objPtr->bytes[newLength] = 0;
     objPtr->length = newLength;
 }
@@ -1615,1163 +1525,178 @@ AppendUtfToUtfRep(
  *
  * Tcl_AppendStringsToObjVA --
  *
- *	This function appends one or more null-terminated strings to an
- *	object.
+ *	This procedure 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(
-    Tcl_Obj *objPtr,		/* Points to the object to append to. */
-    va_list argList)		/* Variable argument list. */
+Tcl_AppendStringsToObjVA (objPtr, argList)
+    Tcl_Obj *objPtr;		/* Points to the object to append to. */
+    va_list argList;		/* Variable argument list. */
 {
+#define STATIC_LIST_SIZE 16
+    String *stringPtr;
+    int newLength, oldLength, attemptLength;
+    register char *string, *dst;
+    char *static_list[STATIC_LIST_SIZE];
+    char **args = static_list;
+    int nargs_space = STATIC_LIST_SIZE;
+    int nargs, i;
+
     if (Tcl_IsShared(objPtr)) {
-	Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
+	panic("Tcl_AppendStringsToObj called with shared object");
     }
 
-    while (1) {
-	const char *bytes = va_arg(argList, char *);
-
-	if (bytes == NULL) {
-	    break;
-	}
-	Tcl_AppendToObj(objPtr, bytes, -1);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AppendStringsToObj --
- *
- *	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.
- *
- *----------------------------------------------------------------------
- */
+    SetStringFromAny(NULL, objPtr);
 
-void
-Tcl_AppendStringsToObj(
-    Tcl_Obj *objPtr,
-    ...)
-{
-    va_list argList;
+    /*
+     * Force the existence of a string rep. so we avoid crashes operating
+     * on a pure unicode value.  [Bug 2597185]
+     */
 
-    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, *errCode;
-    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 *const 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;
+    (void) Tcl_GetStringFromObj(objPtr, &oldLength);
 
     /*
-     * Format string is NUL-terminated.
+     * 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.
      */
 
-    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;
-		errCode = "OVERFLOW";
-		goto errorMsg;
-	    }
-	    Tcl_AppendToObj(appendObj, span, numBytes);
-	    limit -= numBytes;
-	    numBytes = 0;
+    nargs = 0;
+    newLength = 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 *));
+ 	    }
+ 	}
+	newLength += strlen(string);
+	args[nargs++] = string;
+    }
+    if (newLength == 0) {
+	goto done;
+    }
 
-	/*
-	 * 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;
-	}
+    stringPtr = GET_STRING(objPtr);
+    if (oldLength + newLength > (int) stringPtr->allocated) {
 
 	/*
-	 * Step 1. XPG3 position specifier
+	 * 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.
 	 */
 
-	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;
-		errCode = "MIXEDSPECTYPES";
-		goto errorMsg;
-	    }
-	    gotXpg = 1;
+	if (oldLength == 0) {
+	    Tcl_SetObjLength(objPtr, newLength);
 	} else {
-	    if (gotXpg) {
-		msg = mixedXPG;
-		errCode = "MIXEDSPECTYPES";
-		goto errorMsg;
-	    }
-	    gotSequential = 1;
-	}
-	if ((objIndex < 0) || (objIndex >= objc)) {
-	    msg = badIndex[gotXpg];
-	    errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
-	    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];
-		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
-		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;
-	    errCode = "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];
-		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
-		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);
-#ifndef TCL_WIDE_INT_IS_LONG
-	    } else {
-		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";
-	    errCode = "INCOMPLETE";
-	    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";
-		errCode = "BADUNSIGNED";
-		goto errorMsg;
-	    }
-	case 'd':
-	case 'o':
-	case 'x':
-	case 'X':
-	case 'b': {
-	    short 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) l;
-		    isNegative = (s < (short) 0);
-		} else {
-		    isNegative = (l < (long) 0);
-		}
-	    } else if (useShort) {
-		s = (short) l;
-		isNegative = (s < (short) 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;
-		case 'b':
-		    Tcl_AppendToObj(segment, "0b", 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;
-		    errCode = "OVERFLOW";
-		    goto errorMsg;
-		}
-		Tcl_AppendToObj(segment, bytes, toAppend);
-		Tcl_DecrRefCount(pure);
-		break;
-	    }
-
-	    case 'u':
-	    case 'o':
-	    case 'x':
-	    case 'X':
-	    case 'b': {
-		Tcl_WideUInt bits = (Tcl_WideUInt) 0;
-		Tcl_WideInt numDigits = (Tcl_WideInt) 0;
-		int length, numBits = 4, base = 16, index = 0, shift = 0;
-		Tcl_Obj *pure;
-		char *bytes;
-
-		if (ch == 'u') {
-		    base = 10;
-		} else if (ch == 'o') {
-		    base = 8;
-		    numBits = 3;
-		} else if (ch == 'b') {
-		    base = 2;
-		    numBits = 1;
-		}
-		if (useShort) {
-		    unsigned short us = (unsigned short) 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;
-			errCode = "OVERFLOW";
-			goto errorMsg;
-		    }
-		} else if (!useBig) {
-		    unsigned long ul = (unsigned long) 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;
-		    errCode = "OVERFLOW";
-		    goto errorMsg;
-		}
-		Tcl_AppendObjToObj(segment, pure);
-		Tcl_DecrRefCount(pure);
-		break;
-	    }
-
+	    attemptLength = 2 * (oldLength + newLength);
+	    if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
+		attemptLength = oldLength + (2 * newLength) +
+		    TCL_GROWTH_MIN_ALLOC;
+		Tcl_SetObjLength(objPtr, attemptLength);
 	    }
-	    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;
-		    errCode = "OVERFLOW";
-		    goto errorMsg;
-		}
-		length += precision;
-	    }
-
-	    /*
-	     * Don't pass length modifiers!
-	     */
-
-	    *p++ = (char) ch;
-	    *p = '\0';
+    /*
+     * Make a second pass through the arguments, appending all the
+     * strings to the object.
+     */
 
-	    segment = Tcl_NewObj();
-	    allocSegment = 1;
-	    if (!Tcl_AttemptSetObjLength(segment, length)) {
-		msg = overflow;
-		errCode = "OVERFLOW";
-		goto errorMsg;
-	    }
-	    bytes = TclGetString(segment);
-	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
-		msg = overflow;
-		errCode = "OVERFLOW";
-		goto errorMsg;
-	    }
+    dst = objPtr->bytes + oldLength;
+    for (i = 0; i < nargs; ++i) {
+ 	string = args[i];
+	if (string == NULL) {
 	    break;
 	}
-	default:
-	    if (interp != NULL) {
-		Tcl_SetObjResult(interp,
-			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
-		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
-	    }
-	    goto error;
-	}
-
-	switch (ch) {
-	case 'E':
-	case 'G':
-	case 'X': {
-	    Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment)));
-	}
+	while (*string != 0) {
+	    *dst = *string;
+	    dst++;
+	    string++;
 	}
-
-	if (width>0 && numChars<0) {
-	    numChars = Tcl_GetCharLength(segment);
-	}
-	if (!gotMinus && width>0) {
-	    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;
-	    errCode = "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;
-	    errCode = "OVERFLOW";
-	    goto errorMsg;
-	}
-	Tcl_AppendToObj(appendObj, span, numBytes);
-	limit -= numBytes;
-	numBytes = 0;
     }
 
-    return TCL_OK;
+    /*
+     * 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.
+     */
 
-  errorMsg:
-    if (interp != NULL) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
-	Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL);
+    if (dst != NULL) {
+	*dst = 0;
     }
-  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();
+    objPtr->length = oldLength + newLength;
 
-    result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
-    if (result != TCL_OK) {
-	Tcl_DecrRefCount(objPtr);
-	return NULL;
+    done:
+    /*
+     * If we had to allocate a buffer from the heap, 
+     * free it now.
+     */
+ 
+    if (args != static_list) {
+     	ckfree((void *)args);
     }
-    return objPtr;
+#undef STATIC_LIST_SIZE
 }
 
 /*
- *---------------------------------------------------------------------------
- *
- * 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;
-
-    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) va_arg(argList, int)));
-		    break;
-		case 1:
-		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
-			    va_arg(argList, long)));
-		    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': {
-		char *end;
-
-		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_AppendStringsToObj --
  *
- * Tcl_AppendPrintfToObj --
+ *	This procedure appends one or more null-terminated strings
+ *	to an object.
  *
  * 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.
+ *	The contents of all the string arguments are appended to the
+ *	string representation of objPtr.
  *
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-Tcl_ObjPrintf(
-    const char *format,
-    ...)
+void
+Tcl_AppendStringsToObj TCL_VARARGS_DEF(Tcl_Obj *,arg1)
 {
+    register Tcl_Obj *objPtr;
     va_list argList;
-    Tcl_Obj *objPtr = Tcl_NewObj();
 
-    va_start(argList, format);
-    AppendPrintfToObjVA(objPtr, format, argList);
+    objPtr = TCL_VARARGS_START(Tcl_Obj *,arg1,argList);
+    Tcl_AppendStringsToObjVA(objPtr, 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.
- *
- *---------------------------------------------------------------------------
- */
-
-static void
-ReverseBytes(
-    unsigned char *to,		/* Copy bytes into here... */
-    unsigned char *from,	/* ...from here... */
-    int count)		/* Until this many are copied, */
-				/* reversing as you go. */
-{
-    unsigned char *src = from + count;
-    if (to == from) {
-	/* Reversing in place */
-	while (--src > to) {
-	    unsigned char c = *src;
-	    *src = *to;
-	    *to++ = c;
-	}
-    }  else {
-	while (--src >= from) {
-	    *to++ = *src;
-	}
-    }
-}
-
-Tcl_Obj *
-TclStringObjReverse(
-    Tcl_Obj *objPtr)
-{
-    String *stringPtr;
-    Tcl_UniChar ch;
-
-    if (TclIsPureByteArray(objPtr)) {
-	int numBytes;
-	unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);
-
-	if (Tcl_IsShared(objPtr)) {
-	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
-	}
-	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
-	return objPtr;
-    }
-
-    SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(objPtr);
-
-    if (stringPtr->hasUnicode) {
-	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
-	Tcl_UniChar *src = from + stringPtr->numChars;
-
-	if (Tcl_IsShared(objPtr)) {
-	    Tcl_UniChar *to;
-
-	    /*
-	     * Create a non-empty, pure unicode value, so we can coax
-	     * Tcl_SetObjLength into growing the unicode rep buffer.
-	     */
-
-	    ch = 0;
-	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
-	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
-	    to = Tcl_GetUnicode(objPtr);
-	    while (--src >= from) {
-		*to++ = *src;
-	    }
-	} else {
-	    /* Reversing in place */
-	    while (--src > from) {
-		ch = *src;
-		*src = *from;
-		*from++ = ch;
-	    }
-	}
-    }
-
-    if (objPtr->bytes) {
-	int numChars = stringPtr->numChars;
-	int numBytes = objPtr->length;
-	char *to, *from = objPtr->bytes;
-
-	if (Tcl_IsShared(objPtr)) {
-	    objPtr = Tcl_NewObj();
-	    Tcl_SetObjLength(objPtr, numBytes);
-	}
-	to = objPtr->bytes;
-
-	if (numChars < numBytes) {
-	    /*
-	     * Either numChars == -1 and we don't know how many chars are
-	     * represented by objPtr->bytes and we need Pass 1 just in case,
-	     * or numChars >= 0 and we know we have fewer chars than bytes,
-	     * so we know there's a multibyte character needing Pass 1.
-	     *
-	     * Pass 1. Reverse the bytes of each multi-byte character.
-	     */
-	    int charCount = 0;
-	    int bytesLeft = numBytes;
-
-	    while (bytesLeft) {
-		/*
-		 * NOTE: We know that the from buffer is NUL-terminated.
-		 * It's part of the contract for objPtr->bytes values.
-		 * Thus, we can skip calling Tcl_UtfCharComplete() here.
-		 */
-		int bytesInChar = Tcl_UtfToUniChar(from, &ch);
-
-		ReverseBytes((unsigned char *)to, (unsigned char *)from,
-			bytesInChar);
-		to += bytesInChar;
-		from += bytesInChar;
-		bytesLeft -= bytesInChar;
-		charCount++;
-	    }
-
-	    from = to = objPtr->bytes;
-	    stringPtr->numChars = charCount;
-	}
-	/* Pass 2. Reverse all the bytes. */
-	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
-    }
-
-    return objPtr;
 }
 
 /*
@@ -2780,7 +1705,7 @@ TclStringObjReverse(
  * 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.
@@ -2792,47 +1717,39 @@ TclStringObjReverse(
  */
 
 static void
-FillUnicodeRep(
-    Tcl_Obj *objPtr)		/* The object in which to fill the unicode
-				 * rep. */
-{
-    String *stringPtr = GET_STRING(objPtr);
-
-    ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
-	    stringPtr->numChars);
-}
-
-static void
-ExtendUnicodeRepWithString(
-    Tcl_Obj *objPtr,
-    const char *bytes,
-    int numBytes,
-    int numAppendChars)
+FillUnicodeRep(objPtr)
+    Tcl_Obj *objPtr;	/* The object in which to fill the unicode rep. */
 {
-    String *stringPtr = GET_STRING(objPtr);
-    int needed, numOrigChars = 0;
+    String *stringPtr;
+    size_t uallocated;
+    char *src, *srcEnd;
     Tcl_UniChar *dst;
-
-    if (stringPtr->hasUnicode) {
-	numOrigChars = stringPtr->numChars;
-    }
-    if (numAppendChars == -1) {
-	TclNumUtfChars(numAppendChars, bytes, numBytes);
+    src = objPtr->bytes;
+    
+    stringPtr = GET_STRING(objPtr);
+    if (stringPtr->numChars == -1) {
+	stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
     }
-    needed = numOrigChars + numAppendChars;
-    stringCheckLimits(needed);
-	
-    if (needed > stringPtr->maxChars) {
-	GrowUnicodeBuffer(objPtr, needed);
+    stringPtr->hasUnicode = (stringPtr->numChars > 0);
+
+    stringCheckLimits(stringPtr->numChars);
+    uallocated = STRING_UALLOC(stringPtr->numChars);
+    if (uallocated > stringPtr->uallocated) {
+	GrowUnicodeBuffer(objPtr, stringPtr->numChars);
 	stringPtr = GET_STRING(objPtr);
     }
 
-    stringPtr->hasUnicode = 1;
-    stringPtr->numChars = needed;
-    for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
-	bytes += TclUtfToUniChar(bytes, dst);
+    /*
+     * 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);
 }
 
 /*
@@ -2840,8 +1757,8 @@ ExtendUnicodeRepWithString(
  *
  * 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.
@@ -2854,93 +1771,46 @@ ExtendUnicodeRepWithString(
  */
 
 static void
-DupStringInternalRep(
-    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. Must have
-				 * an internal rep of type "String". */
-    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
-				 * currently have an internal rep.*/
+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.*/
 {
     String *srcStringPtr = GET_STRING(srcPtr);
     String *copyStringPtr = NULL;
 
-#if COMPAT==0
-    if (srcStringPtr->numChars == -1) {
-	/*
-	 * The String struct in the source value holds zero useful data. Don't
-	 * bother copying it. Don't even bother allocating space in which to
-	 * copy it. Just let the copy be untyped.
-	 */
-
-	return;
-    }
-
-    if (srcStringPtr->hasUnicode) {
-	int copyMaxChars;
+    /*
+     * 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->uallocated = 0;
+    } else {
+	copyStringPtr = (String *) ckalloc(
+	    STRING_SIZE(srcStringPtr->uallocated));
+	copyStringPtr->uallocated = srcStringPtr->uallocated;
 
-	if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
-	    copyMaxChars = 2 * srcStringPtr->numChars;
-	} else {
-	    copyMaxChars = srcStringPtr->maxChars;
-	}
-	copyStringPtr = stringAttemptAlloc(copyMaxChars);
-	if (copyStringPtr == NULL) {
-	    copyMaxChars = srcStringPtr->numChars;
-	    copyStringPtr = stringAlloc(copyMaxChars);
-	}
-	copyStringPtr->maxChars = copyMaxChars;
-	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
-		srcStringPtr->numChars * sizeof(Tcl_UniChar));
+	memcpy((VOID *) copyStringPtr->unicode,
+		(VOID *) srcStringPtr->unicode,
+		(size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
 	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
-    } else {
-	copyStringPtr = stringAlloc(0);
-	copyStringPtr->maxChars = 0;
-	copyStringPtr->unicode[0] = 0;
     }
-    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
     copyStringPtr->numChars = srcStringPtr->numChars;
+    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
+    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.
-     */
-
-    copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
-#else /* COMPAT!=0 */
-    /*
-     * 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.
+     * 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.
      */
 
-    if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
-	/*
-	 * Copy the full allocation for the Unicode buffer.
-	 */
-
-	copyStringPtr = stringAlloc(srcStringPtr->maxChars);
-	copyStringPtr->maxChars = srcStringPtr->maxChars;
-	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
-		srcStringPtr->numChars * sizeof(Tcl_UniChar));
-	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
-	copyStringPtr->allocated = 0;
-    } else {
-	copyStringPtr = stringAlloc(0);
-	copyStringPtr->unicode[0] = 0;
-	copyStringPtr->maxChars = 0;
-
-	/*
-	 * 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;
-    }
-    copyStringPtr->numChars = srcStringPtr->numChars;
-    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
-#endif /* COMPAT==0 */
+    copyStringPtr->allocated = copyPtr->length;
 
     SET_STRING(copyPtr, copyStringPtr);
     copyPtr->typePtr = &tclStringType;
@@ -2957,38 +1827,54 @@ DupStringInternalRep(
  *	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(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr)		/* The object to convert. */
+SetStringFromAny(interp, objPtr)
+    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
+    register Tcl_Obj *objPtr;	/* The object to convert. */
 {
-    if (objPtr->typePtr != &tclStringType) {
-	String *stringPtr = stringAlloc(0);
+    /*
+     * 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.
+     */
 
-	/*
-	 * Convert whatever we have into an untyped value. Just A String.
-	 */
+    if (objPtr->typePtr != &tclStringType) {
+	String *stringPtr;
 
-	(void) TclGetString(objPtr);
-	TclFreeIntRep(objPtr);
+	if (objPtr->typePtr != NULL) {
+	    if (objPtr->bytes == NULL) {
+		objPtr->typePtr->updateStringProc(objPtr);
+	    }
+	    if ((objPtr->typePtr->freeIntRepProc) != NULL) {
+		(*objPtr->typePtr->freeIntRepProc)(objPtr);
+	    }
+	}
+	objPtr->typePtr = &tclStringType;
 
 	/*
-	 * Create a basic String intrep that just points to the UTF-8 string
-	 * already in place at objPtr->bytes.
+	 * Allocate enough space for the basic String structure.
 	 */
 
+	stringPtr = (String *) ckalloc(sizeof(String));
 	stringPtr->numChars = -1;
-	stringPtr->allocated = objPtr->length;
-	stringPtr->maxChars = 0;
+	stringPtr->uallocated = 0;
 	stringPtr->hasUnicode = 0;
+
+	if (objPtr->bytes != NULL) {
+	    stringPtr->allocated = objPtr->length;	    
+	    if (objPtr->bytes != tclEmptyStringRep) {
+		objPtr->bytes[objPtr->length] = 0;
+	    }
+	} else {
+	    objPtr->length = 0;
+	}
 	SET_STRING(objPtr, stringPtr);
-	objPtr->typePtr = &tclStringType;
     }
     return TCL_OK;
 }
@@ -3005,85 +1891,69 @@ SetStringFromAny(
  *	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(
-    Tcl_Obj *objPtr)		/* Object with string rep to update. */
+UpdateStringOfString(objPtr)
+    Tcl_Obj *objPtr;		/* Object with string rep to update. */
 {
-    String *stringPtr = GET_STRING(objPtr);
-
-    if (stringPtr->numChars == 0) {
-	TclInitStringRep(objPtr, tclEmptyStringRep, 0);
-    } else {
-	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
-		stringPtr->numChars);
-    }
-}
+    int i, size;
+    Tcl_UniChar *unicode;
+    char dummy[TCL_UTF_MAX];
+    char *dst;
+    String *stringPtr;
 
-static int
-ExtendStringRepWithUnicode(
-    Tcl_Obj *objPtr,
-    const Tcl_UniChar *unicode,
-    int numChars)
-{
-    /*
-     * Pre-condition: this is the "string" Tcl_ObjType.
-     */
+    stringPtr = GET_STRING(objPtr);
+    if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
 
-    int i, origLength, size = 0;	
-    char *dst, buf[TCL_UTF_MAX];
-    String *stringPtr = GET_STRING(objPtr);
+	if (stringPtr->numChars <= 0) {
 
-    if (numChars < 0) {
-	numChars = UnicodeLength(unicode);
-    }
+	    /*
+	     * If there is no Unicode rep, or the string has 0 chars,
+	     * then set the string rep to an empty string.
+	     */
 
-    if (numChars == 0) {
-	return 0;
-    }
+	    objPtr->bytes = tclEmptyStringRep;
+	    objPtr->length = 0;
+	    return;
+	}
 
-    if (objPtr->bytes == NULL) {
-	objPtr->length = 0;
-    }
-    size = origLength = objPtr->length;
-    
-    /*
-     * Quick cheap check in case we have more than enough room.
-     */
+	unicode = stringPtr->unicode;
 
-    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX 
-	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
-	goto copyBytes;
-    }
+	/*
+	 * Translate the Unicode string to UTF.  "size" will hold the
+	 * amount of space the UTF string needs.
+	 */
 
-    for (i = 0; i < numChars && size >= 0; i++) {
-	size += Tcl_UniCharToUtf((int) unicode[i], buf);
-    }
-    if (size < 0) {
-	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
-    }
+	if (stringPtr->numChars <= INT_MAX/TCL_UTF_MAX
+		&& stringPtr->allocated >= (size_t) (stringPtr->numChars * TCL_UTF_MAX)) {
+	    goto copyBytes;
+	}
 
-    /*
-     * Grow space if needed.
-     */
+	size = 0;
+	for (i = 0; i < stringPtr->numChars && size >= 0; i++) {
+	    size += Tcl_UniCharToUtf((int) unicode[i], dummy);
+	}
+	if (size < 0) {
+	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+	}
 
-    if (size > stringPtr->allocated) {
-	GrowStringBuffer(objPtr, size, 1);
-    }
+	objPtr->bytes = (char *) ckalloc((unsigned) (size + 1));
+	objPtr->length = size;
+	stringPtr->allocated = size;
 
-  copyBytes:
-    dst = objPtr->bytes + origLength;
-    for (i = 0; i < numChars; i++) {
-	dst += Tcl_UniCharToUtf((int) unicode[i], dst);
+    copyBytes:
+	dst = objPtr->bytes;
+	for (i = 0; i < stringPtr->numChars; i++) {
+	    dst += Tcl_UniCharToUtf(unicode[i], dst);
+	}
+	*dst = '\0';
     }
-    *dst = '\0';
-    objPtr->length = dst - objPtr->bytes;
-    return numChars;
+    return;
 }
 
 /*
@@ -3091,30 +1961,21 @@ ExtendStringRepWithUnicode(
  *
  * 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(
-    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
+FreeStringInternalRep(objPtr)
+    Tcl_Obj *objPtr;		/* Object with internal rep to free. */
 {
-    ckfree(GET_STRING(objPtr));
-    objPtr->typePtr = NULL;
+    ckfree((char *) GET_STRING(objPtr));
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 3483074..3b39416 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1,4 +1,4 @@
-/*
+/* 
  * tclStubInit.c --
  *
  *	This file contains the initializers for the Tcl stub vectors.
@@ -10,13 +10,7 @@
  */
 
 #include "tclInt.h"
-#include "tommath.h"
-
-#ifdef __GNUC__
-#pragma GCC dependency "tcl.decls"
-#pragma GCC dependency "tclInt.decls"
-#pragma GCC dependency "tclTomMath.decls"
-#endif
+#include "tclPort.h"
 
 /*
  * Remove macros that will interfere with the definitions below.
@@ -37,19 +31,41 @@
 #undef Tcl_ValidateAllMemory
 #undef Tcl_FindHashEntry
 #undef Tcl_CreateHashEntry
-#undef Tcl_Panic
-#undef Tcl_FindExecutable
 #undef TclpGetPid
 #undef TclSockMinimumBuffers
 
+/*
+ * Keep a record of the original Notifier procedures, created in the
+ * same compilation unit as the stub tables so we can later do reliable,
+ * portable comparisons to see whether a Tcl_SetNotifier() call swapped
+ * new routines into the stub table.
+ */
+
+Tcl_NotifierProcs tclOriginalNotifier = {
+    Tcl_SetTimer,
+    Tcl_WaitForEvent,
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    Tcl_CreateFileHandler,
+    Tcl_DeleteFileHandler,
+#else
+    NULL,
+    NULL,
+#endif
+    NULL,
+    NULL,
+    NULL,
+    NULL
+};
+
 /* See bug 510001: TclSockMinimumBuffers needs plat imp */
 #ifdef _WIN64
 #   define TclSockMinimumBuffersOld 0
 #else
-#define TclSockMinimumBuffersOld sockMinimumBuffersOld
-static int TclSockMinimumBuffersOld(int sock, int size)
+int TclSockMinimumBuffersOld(sock, size)
+    int sock;
+    int size;
 {
-    return TclSockMinimumBuffers(INT2PTR(sock), size);
+    return TclSockMinimumBuffers((void *) (size_t) sock, size);
 }
 #endif
 
@@ -147,7 +163,7 @@ doNothing(void)
 
 static char *
 Tcl_WinUtfToTChar(string, len, dsPtr)
-    const char *string;
+    CONST char *string;
     int len;
     Tcl_DString *dsPtr;
 {
@@ -160,7 +176,7 @@ Tcl_WinUtfToTChar(string, len, dsPtr)
 
 static char *
 Tcl_WinTCharToUtf(
-    const char *string,
+    CONST char *string,
     int len,
     Tcl_DString *dsPtr)
 {
@@ -171,28 +187,27 @@ Tcl_WinTCharToUtf(
 	    string, len, dsPtr);
 }
 
-#define Tcl_MacOSXOpenBundleResources (int (*) ( \
-		Tcl_Interp *, const char *, int, int, char *)) Tcl_WinUtfToTChar
-#define Tcl_MacOSXOpenVersionedBundleResources (int (*) ( \
-		Tcl_Interp *, const char *, const char *, int, int, char *)) Tcl_WinTCharToUtf
-#define TclMacOSXGetFileAttribute (int (*) (Tcl_Interp *,  \
-		int, Tcl_Obj *, Tcl_Obj **)) TclpCreateProcess
-#define TclMacOSXMatchType (int (*) (Tcl_Interp *, const char *, \
-		const char *, Tcl_StatBuf *, Tcl_GlobTypeData *)) TclpMakeFile
-#define TclMacOSXNotifierAddRunLoopMode (void (*) (const void *)) TclpOpenFile
-#define TclpLocaltime_unix (struct tm *(*) (const time_t *)) TclGetAndDetachPids
-#define TclpGmtime_unix (struct tm *(*) (const time_t *)) TclpCloseFile
+#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \
+		Tcl_Interp *, CONST char *, int, int, char *))) Tcl_WinUtfToTChar
+#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \
+		Tcl_Interp *, CONST char *, CONST char *, int, int, char *))) Tcl_WinTCharToUtf
+#define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *,  \
+		int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess
+#define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, CONST char *, \
+		CONST char *, Tcl_StatBuf *, Tcl_GlobTypeData *))) TclpMakeFile
+#define TclMacOSXNotifierAddRunLoopMode (void (*) _ANSI_ARGS_((CONST void *))) TclpOpenFile
+#define TclpLocaltime_unix (struct tm *(*) _ANSI_ARGS_((TclpTime_t_CONST))) TclGetAndDetachPids
+#define TclpGmtime_unix (struct tm *(*) _ANSI_ARGS_((TclpTime_t_CONST))) TclpCloseFile
 
 #elif !defined(__WIN32__) /* UNIX and MAC */
-#   define TclWinConvertError (void (*) (unsigned int)) TclGetAndDetachPids
-#   undef TclWinConvertWSAError
-#   define TclWinConvertWSAError (void (*) (unsigned int)) TclpCloseFile
+#   define TclWinConvertError (void (*) _ANSI_ARGS_((unsigned int))) TclGetAndDetachPids
+#   define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile
 #   define TclWinGetPlatformId (int (*)()) TclpCreateTempFile
 #   define TclWinGetTclInstance (void *(*)()) TclpCreateProcess
 #   define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile
-#   define TclWinSetSockOpt (int (*) (void *, int, int, const char *, int)) TclpOpenFile
-#   define TclWinGetSockOpt (int (*) (void *, int, int, char *, int *)) TclpCreatePipe
-#   define TclWinGetServByName (struct servent *(*) (const char *nm, const char *proto)) TclpCreateCommandChannel
+#   define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, CONST char *, int))) TclpOpenFile
+#   define TclWinGetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, char *, int *))) TclpCreatePipe
+#   define TclWinGetServByName (struct servent *(*) _ANSI_ARGS_((const char *nm, const char *proto))) TclpCreateCommandChannel
 #   define TclIntPlatReserved13 (void (*) ()) TclpInetNtoa
 #   define TclWinAddProcess 0
 #   define TclWinNoBackslash 0
@@ -200,10 +215,10 @@ Tcl_WinTCharToUtf(
 #   define TclWinFlushDirtyChannels 0
 #   define TclWinResetInterfaces 0
 #   define TclpGetPid 0
+#   define TclMacOSXGetFileAttribute 0 /* Only implemented in Tcl >= 8.5 */
+#   define TclMacOSXMatchType 0 /* Only implemented in Tcl >= 8.5 */
+#   define TclMacOSXNotifierAddRunLoopMode 0 /* Only implemented in Tcl >= 8.5 */
 #   ifndef MAC_OSX_TCL
-#	define TclMacOSXMatchType 0
-#	define TclMacOSXNotifierAddRunLoopMode 0
-#	define TclMacOSXGetFileAttribute 0
 #	define Tcl_MacOSXOpenBundleResources 0
 #	define Tcl_MacOSXOpenVersionedBundleResources 0
 #   endif
@@ -217,125 +232,154 @@ Tcl_WinTCharToUtf(
  * below should be made in the generic/tcl.decls script.
  */
 
-MODULE_SCOPE const TclStubs tclStubs;
-MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
-
 /* !BEGIN!: Do not edit below this line. */
 
-static const TclIntStubs tclIntStubs = {
+TclIntStubs tclIntStubs = {
     TCL_STUB_MAGIC,
-    0,
-    0, /* 0 */
-    0, /* 1 */
-    0, /* 2 */
+    NULL,
+    NULL, /* 0 */
+    TclAccessDeleteProc, /* 1 */
+    TclAccessInsertProc, /* 2 */
     TclAllocateFreeObjects, /* 3 */
-    0, /* 4 */
+    NULL, /* 4 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    TclCleanupChildren, /* 5 */
+#endif /* UNIX */
+#ifdef __WIN32__
     TclCleanupChildren, /* 5 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 5 */
+#endif /* MAC_TCL */
     TclCleanupCommand, /* 6 */
     TclCopyAndCollapse, /* 7 */
-    TclCopyChannelOld, /* 8 */
+    TclCopyChannel, /* 8 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     TclCreatePipeline, /* 9 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    TclCreatePipeline, /* 9 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 9 */
+#endif /* MAC_TCL */
     TclCreateProc, /* 10 */
     TclDeleteCompiledLocalVars, /* 11 */
     TclDeleteVars, /* 12 */
-    0, /* 13 */
+    TclDoGlob, /* 13 */
     TclDumpMemoryInfo, /* 14 */
-    0, /* 15 */
+    NULL, /* 15 */
     TclExprFloatError, /* 16 */
-    0, /* 17 */
-    0, /* 18 */
-    0, /* 19 */
-    0, /* 20 */
-    0, /* 21 */
+    NULL, /* 17 */
+    NULL, /* 18 */
+    NULL, /* 19 */
+    NULL, /* 20 */
+    NULL, /* 21 */
     TclFindElement, /* 22 */
     TclFindProc, /* 23 */
     TclFormatInt, /* 24 */
     TclFreePackageInfo, /* 25 */
-    0, /* 26 */
-    0, /* 27 */
+    NULL, /* 26 */
+    TclGetDate, /* 27 */
     TclpGetDefaultStdChannel, /* 28 */
-    0, /* 29 */
-    0, /* 30 */
+    NULL, /* 29 */
+    NULL, /* 30 */
     TclGetExtension, /* 31 */
     TclGetFrame, /* 32 */
-    0, /* 33 */
+    TclGetInterpProc, /* 33 */
     TclGetIntForIndex, /* 34 */
-    0, /* 35 */
-    0, /* 36 */
+    NULL, /* 35 */
+    TclGetLong, /* 36 */
     TclGetLoadedPackages, /* 37 */
     TclGetNamespaceForQualName, /* 38 */
     TclGetObjInterpProc, /* 39 */
     TclGetOpenMode, /* 40 */
     TclGetOriginalCommand, /* 41 */
     TclpGetUserHome, /* 42 */
-    0, /* 43 */
+    TclGlobalInvoke, /* 43 */
     TclGuessPackageName, /* 44 */
     TclHideUnsafeCommands, /* 45 */
     TclInExit, /* 46 */
-    0, /* 47 */
-    0, /* 48 */
-    0, /* 49 */
+    NULL, /* 47 */
+    NULL, /* 48 */
+    TclIncrVar2, /* 49 */
     TclInitCompiledLocals, /* 50 */
     TclInterpInit, /* 51 */
-    0, /* 52 */
+    TclInvoke, /* 52 */
     TclInvokeObjectCommand, /* 53 */
     TclInvokeStringCommand, /* 54 */
     TclIsProc, /* 55 */
-    0, /* 56 */
-    0, /* 57 */
+    NULL, /* 56 */
+    NULL, /* 57 */
     TclLookupVar, /* 58 */
-    0, /* 59 */
+    NULL, /* 59 */
     TclNeedSpace, /* 60 */
     TclNewProcBodyObj, /* 61 */
     TclObjCommandComplete, /* 62 */
     TclObjInterpProc, /* 63 */
     TclObjInvoke, /* 64 */
-    0, /* 65 */
-    0, /* 66 */
-    0, /* 67 */
-    0, /* 68 */
+    TclObjInvokeGlobal, /* 65 */
+    TclOpenFileChannelDeleteProc, /* 66 */
+    TclOpenFileChannelInsertProc, /* 67 */
+    NULL, /* 68 */
     TclpAlloc, /* 69 */
-    0, /* 70 */
-    0, /* 71 */
-    0, /* 72 */
-    0, /* 73 */
+    NULL, /* 70 */
+    NULL, /* 71 */
+    NULL, /* 72 */
+    NULL, /* 73 */
     TclpFree, /* 74 */
     TclpGetClicks, /* 75 */
     TclpGetSeconds, /* 76 */
     TclpGetTime, /* 77 */
-    0, /* 78 */
-    0, /* 79 */
-    0, /* 80 */
+    TclpGetTimeZone, /* 78 */
+    NULL, /* 79 */
+    NULL, /* 80 */
     TclpRealloc, /* 81 */
-    0, /* 82 */
-    0, /* 83 */
-    0, /* 84 */
-    0, /* 85 */
-    0, /* 86 */
-    0, /* 87 */
+    NULL, /* 82 */
+    NULL, /* 83 */
+    NULL, /* 84 */
+    NULL, /* 85 */
+    NULL, /* 86 */
+    NULL, /* 87 */
     TclPrecTraceProc, /* 88 */
     TclPreventAliasLoop, /* 89 */
-    0, /* 90 */
+    NULL, /* 90 */
     TclProcCleanupProc, /* 91 */
     TclProcCompileProc, /* 92 */
     TclProcDeleteProc, /* 93 */
-    0, /* 94 */
-    0, /* 95 */
+    TclProcInterpProc, /* 94 */
+    NULL, /* 95 */
     TclRenameCommand, /* 96 */
     TclResetShadowedCmdRefs, /* 97 */
     TclServiceIdle, /* 98 */
-    0, /* 99 */
-    0, /* 100 */
+    NULL, /* 99 */
+    NULL, /* 100 */
     TclSetPreInitScript, /* 101 */
     TclSetupEnv, /* 102 */
     TclSockGetPort, /* 103 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    TclSockMinimumBuffersOld, /* 104 */
+#endif /* UNIX */
+#ifdef __WIN32__
     TclSockMinimumBuffersOld, /* 104 */
-    0, /* 105 */
-    0, /* 106 */
-    0, /* 107 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 104 */
+#endif /* MAC_TCL */
+    NULL, /* 105 */
+    TclStatDeleteProc, /* 106 */
+    TclStatInsertProc, /* 107 */
     TclTeardownNamespace, /* 108 */
     TclUpdateReturnInfo, /* 109 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     TclSockMinimumBuffers, /* 110 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    TclSockMinimumBuffers, /* 110 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 110 */
+#endif /* MAC_TCL */
     Tcl_AddInterpResolvers, /* 111 */
     Tcl_AppendExportList, /* 112 */
     Tcl_CreateNamespace, /* 113 */
@@ -359,13 +403,13 @@ static const TclIntStubs tclIntStubs = {
     Tcl_SetNamespaceResolvers, /* 131 */
     TclpHasSockets, /* 132 */
     TclpGetDate, /* 133 */
-    0, /* 134 */
-    0, /* 135 */
-    0, /* 136 */
-    0, /* 137 */
+    TclpStrftime, /* 134 */
+    TclpCheckStackSpace, /* 135 */
+    NULL, /* 136 */
+    NULL, /* 137 */
     TclGetEnv, /* 138 */
-    0, /* 139 */
-    0, /* 140 */
+    NULL, /* 139 */
+    TclLooksLikeInt, /* 140 */
     TclpGetCwd, /* 141 */
     TclSetByteCodeFromAny, /* 142 */
     TclAddLiteralObj, /* 143 */
@@ -379,115 +423,64 @@ static const TclIntStubs tclIntStubs = {
     TclRegExpRangeUniChar, /* 151 */
     TclSetLibraryPath, /* 152 */
     TclGetLibraryPath, /* 153 */
-    0, /* 154 */
-    0, /* 155 */
+    NULL, /* 154 */
+    NULL, /* 155 */
     TclRegError, /* 156 */
     TclVarTraceExists, /* 157 */
-    0, /* 158 */
-    0, /* 159 */
-    0, /* 160 */
+    TclSetStartupScriptFileName, /* 158 */
+    TclGetStartupScriptFileName, /* 159 */
+    NULL, /* 160 */
     TclChannelTransform, /* 161 */
     TclChannelEventScriptInvoker, /* 162 */
     TclGetInstructionTable, /* 163 */
     TclExpandCodeArray, /* 164 */
     TclpSetInitialEncodings, /* 165 */
     TclListObjSetElement, /* 166 */
-    0, /* 167 */
-    0, /* 168 */
+    TclSetStartupScriptPath, /* 167 */
+    TclGetStartupScriptPath, /* 168 */
     TclpUtfNcmp2, /* 169 */
     TclCheckInterpTraces, /* 170 */
     TclCheckExecutionTraces, /* 171 */
     TclInThreadExit, /* 172 */
     TclUniCharMatch, /* 173 */
-    0, /* 174 */
-    TclCallVarTraces, /* 175 */
-    TclCleanupVar, /* 176 */
-    TclVarErrMsg, /* 177 */
-    0, /* 178 */
-    0, /* 179 */
-    0, /* 180 */
-    0, /* 181 */
+    NULL, /* 174 */
+    NULL, /* 175 */
+    NULL, /* 176 */
+    NULL, /* 177 */
+    NULL, /* 178 */
+    NULL, /* 179 */
+    NULL, /* 180 */
+    NULL, /* 181 */
     TclpLocaltime, /* 182 */
     TclpGmtime, /* 183 */
-    0, /* 184 */
-    0, /* 185 */
-    0, /* 186 */
-    0, /* 187 */
-    0, /* 188 */
-    0, /* 189 */
-    0, /* 190 */
-    0, /* 191 */
-    0, /* 192 */
-    0, /* 193 */
-    0, /* 194 */
-    0, /* 195 */
-    0, /* 196 */
-    0, /* 197 */
-    TclObjGetFrame, /* 198 */
-    0, /* 199 */
-    TclpObjRemoveDirectory, /* 200 */
-    TclpObjCopyDirectory, /* 201 */
-    TclpObjCreateDirectory, /* 202 */
-    TclpObjDeleteFile, /* 203 */
-    TclpObjCopyFile, /* 204 */
-    TclpObjRenameFile, /* 205 */
-    TclpObjStat, /* 206 */
-    TclpObjAccess, /* 207 */
-    TclpOpenFileChannel, /* 208 */
-    0, /* 209 */
-    0, /* 210 */
-    0, /* 211 */
-    TclpFindExecutable, /* 212 */
-    TclGetObjNameOfExecutable, /* 213 */
-    TclSetObjNameOfExecutable, /* 214 */
-    TclStackAlloc, /* 215 */
-    TclStackFree, /* 216 */
-    TclPushStackFrame, /* 217 */
-    TclPopStackFrame, /* 218 */
-    0, /* 219 */
-    0, /* 220 */
-    0, /* 221 */
-    0, /* 222 */
-    0, /* 223 */
-    TclGetPlatform, /* 224 */
-    TclTraceDictPath, /* 225 */
-    TclObjBeingDeleted, /* 226 */
-    TclSetNsPath, /* 227 */
-    0, /* 228 */
-    TclPtrMakeUpvar, /* 229 */
-    TclObjLookupVar, /* 230 */
-    TclGetNamespaceFromObj, /* 231 */
-    TclEvalObjEx, /* 232 */
-    TclGetSrcInfoForPc, /* 233 */
-    TclVarHashCreateVar, /* 234 */
-    TclInitVarHashTable, /* 235 */
-    0, /* 236 */
-    TclResetCancellation, /* 237 */
-    TclNRInterpProc, /* 238 */
-    TclNRInterpProcCore, /* 239 */
-    TclNRRunCallbacks, /* 240 */
-    TclNREvalObjEx, /* 241 */
-    TclNREvalObjv, /* 242 */
-    TclDbDumpActiveObjects, /* 243 */
-    TclGetNamespaceChildTable, /* 244 */
-    TclGetNamespaceCommandTable, /* 245 */
-    TclInitRewriteEnsemble, /* 246 */
-    TclResetRewriteEnsemble, /* 247 */
-    TclCopyChannel, /* 248 */
-    TclDoubleDigits, /* 249 */
-    TclSetSlaveCancelFlags, /* 250 */
+    NULL, /* 184 */
+    NULL, /* 185 */
+    NULL, /* 186 */
+    NULL, /* 187 */
+    NULL, /* 188 */
+    NULL, /* 189 */
+    NULL, /* 190 */
+    NULL, /* 191 */
+    NULL, /* 192 */
+    NULL, /* 193 */
+    NULL, /* 194 */
+    NULL, /* 195 */
+    NULL, /* 196 */
+    NULL, /* 197 */
+    NULL, /* 198 */
+    TclMatchIsTrivial, /* 199 */
 };
 
-static const TclIntPlatStubs tclIntPlatStubs = {
+TclIntPlatStubs tclIntPlatStubs = {
     TCL_STUB_MAGIC,
-    0,
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+    NULL,
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     TclWinConvertError, /* 0 */
     TclWinConvertWSAError, /* 1 */
     TclWinGetServByName, /* 2 */
     TclWinGetSockOpt, /* 3 */
     TclWinGetTclInstance, /* 4 */
-    0, /* 5 */
+    NULL, /* 5 */
     TclWinNToHS, /* 6 */
     TclWinSetSockOpt, /* 7 */
     TclpGetPid, /* 8 */
@@ -496,18 +489,18 @@ static const TclIntPlatStubs tclIntPlatStubs = {
     TclpLocaltime_unix, /* 11 */
     TclpGmtime_unix, /* 12 */
     TclIntPlatReserved13, /* 13 */
-    TclUnixCopyFile, /* 14 */
+    NULL, /* 14 */
     TclMacOSXGetFileAttribute, /* 15 */
-    0, /* 16 */
-    0, /* 17 */
+    NULL, /* 16 */
+    NULL, /* 17 */
     TclMacOSXMatchType, /* 18 */
     TclMacOSXNotifierAddRunLoopMode, /* 19 */
     TclWinAddProcess, /* 20 */
-    0, /* 21 */
+    NULL, /* 21 */
     TclpCreateTempFile, /* 22 */
-    0, /* 23 */
+    NULL, /* 23 */
     TclWinNoBackslash, /* 24 */
-    0, /* 25 */
+    NULL, /* 25 */
     TclWinSetInterfaces, /* 26 */
     TclWinFlushDirtyChannels, /* 27 */
     TclWinResetInterfaces, /* 28 */
@@ -522,174 +515,100 @@ static const TclIntPlatStubs tclIntPlatStubs = {
     TclpOpenFile, /* 37 */
     TclUnixWaitForFile, /* 38 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#ifdef __WIN32__
     TclWinConvertError, /* 0 */
     TclWinConvertWSAError, /* 1 */
     TclWinGetServByName, /* 2 */
     TclWinGetSockOpt, /* 3 */
     TclWinGetTclInstance, /* 4 */
-    0, /* 5 */
+    NULL, /* 5 */
     TclWinNToHS, /* 6 */
     TclWinSetSockOpt, /* 7 */
     TclpGetPid, /* 8 */
     TclWinGetPlatformId, /* 9 */
-    0, /* 10 */
+    NULL, /* 10 */
     TclGetAndDetachPids, /* 11 */
     TclpCloseFile, /* 12 */
     TclpCreateCommandChannel, /* 13 */
     TclpCreatePipe, /* 14 */
     TclpCreateProcess, /* 15 */
-    0, /* 16 */
-    0, /* 17 */
+    NULL, /* 16 */
+    NULL, /* 17 */
     TclpMakeFile, /* 18 */
     TclpOpenFile, /* 19 */
     TclWinAddProcess, /* 20 */
-    0, /* 21 */
+    NULL, /* 21 */
     TclpCreateTempFile, /* 22 */
-    0, /* 23 */
+    TclpGetTZName, /* 23 */
     TclWinNoBackslash, /* 24 */
-    0, /* 25 */
+    TclWinGetPlatform, /* 25 */
     TclWinSetInterfaces, /* 26 */
     TclWinFlushDirtyChannels, /* 27 */
     TclWinResetInterfaces, /* 28 */
     TclWinCPUID, /* 29 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    TclWinConvertError, /* 0 */
-    TclWinConvertWSAError, /* 1 */
-    TclWinGetServByName, /* 2 */
-    TclWinGetSockOpt, /* 3 */
-    TclWinGetTclInstance, /* 4 */
-    0, /* 5 */
-    TclWinNToHS, /* 6 */
-    TclWinSetSockOpt, /* 7 */
-    TclpGetPid, /* 8 */
-    TclWinGetPlatformId, /* 9 */
-    TclpReaddir, /* 10 */
-    TclpLocaltime_unix, /* 11 */
-    TclpGmtime_unix, /* 12 */
-    TclIntPlatReserved13, /* 13 */
-    TclUnixCopyFile, /* 14 */
-    TclMacOSXGetFileAttribute, /* 15 */
-    TclMacOSXSetFileAttribute, /* 16 */
-    TclMacOSXCopyFileAttributes, /* 17 */
-    TclMacOSXMatchType, /* 18 */
-    TclMacOSXNotifierAddRunLoopMode, /* 19 */
-    TclWinAddProcess, /* 20 */
-    0, /* 21 */
-    TclpCreateTempFile, /* 22 */
-    0, /* 23 */
-    TclWinNoBackslash, /* 24 */
-    0, /* 25 */
-    TclWinSetInterfaces, /* 26 */
-    TclWinFlushDirtyChannels, /* 27 */
-    TclWinResetInterfaces, /* 28 */
-    TclWinCPUID, /* 29 */
-    TclGetAndDetachPids, /* 30 */
-    TclpCloseFile, /* 31 */
-    TclpCreateCommandChannel, /* 32 */
-    TclpCreatePipe, /* 33 */
-    TclpCreateProcess, /* 34 */
-    TclpInetNtoa, /* 35 */
-    TclpMakeFile, /* 36 */
-    TclpOpenFile, /* 37 */
-    TclUnixWaitForFile, /* 38 */
-#endif /* MACOSX */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    TclpSysAlloc, /* 0 */
+    TclpSysFree, /* 1 */
+    TclpSysRealloc, /* 2 */
+    TclpExit, /* 3 */
+    FSpGetDefaultDir, /* 4 */
+    FSpSetDefaultDir, /* 5 */
+    FSpFindFolder, /* 6 */
+    GetGlobalMouseTcl, /* 7 */
+    FSpGetDirectoryIDTcl, /* 8 */
+    FSpOpenResFileCompatTcl, /* 9 */
+    FSpCreateResFileCompatTcl, /* 10 */
+    FSpLocationFromPath, /* 11 */
+    FSpPathFromLocation, /* 12 */
+    TclMacExitHandler, /* 13 */
+    TclMacInitExitToShell, /* 14 */
+    TclMacInstallExitToShellPatch, /* 15 */
+    TclMacOSErrorToPosixError, /* 16 */
+    TclMacRemoveTimer, /* 17 */
+    TclMacStartTimer, /* 18 */
+    TclMacTimerExpired, /* 19 */
+    TclMacRegisterResourceFork, /* 20 */
+    TclMacUnRegisterResourceFork, /* 21 */
+    TclMacCreateEnv, /* 22 */
+    TclMacFOpenHack, /* 23 */
+    TclpGetTZName, /* 24 */
+    TclMacChmod, /* 25 */
+    FSpLLocationFromPath, /* 26 */
+#endif /* MAC_TCL */
 };
 
-static const TclPlatStubs tclPlatStubs = {
+TclPlatStubs tclPlatStubs = {
     TCL_STUB_MAGIC,
-    0,
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+    NULL,
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     Tcl_MacOSXOpenBundleResources, /* 0 */
     Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
+#ifdef __WIN32__
     Tcl_WinUtfToTChar, /* 0 */
     Tcl_WinTCharToUtf, /* 1 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    Tcl_MacOSXOpenBundleResources, /* 0 */
-    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
-#endif /* MACOSX */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    Tcl_MacSetEventProc, /* 0 */
+    Tcl_MacConvertTextResource, /* 1 */
+    Tcl_MacEvalResource, /* 2 */
+    Tcl_MacFindResource, /* 3 */
+    Tcl_GetOSTypeFromObj, /* 4 */
+    Tcl_SetOSTypeObj, /* 5 */
+    Tcl_NewOSTypeObj, /* 6 */
+    strncasecmp, /* 7 */
+    strcasecmp, /* 8 */
+#endif /* MAC_TCL */
 };
 
-const TclTomMathStubs tclTomMathStubs = {
-    TCL_STUB_MAGIC,
-    0,
-    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 const TclStubHooks tclStubHooks = {
+static TclStubHooks tclStubHooks = {
     &tclPlatStubs,
     &tclIntStubs,
     &tclIntPlatStubs
 };
 
-const TclStubs tclStubs = {
+TclStubs tclStubs = {
     TCL_STUB_MAGIC,
     &tclStubHooks,
     Tcl_PkgProvideEx, /* 0 */
@@ -701,24 +620,24 @@ const TclStubs tclStubs = {
     Tcl_DbCkalloc, /* 6 */
     Tcl_DbCkfree, /* 7 */
     Tcl_DbCkrealloc, /* 8 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     Tcl_CreateFileHandler, /* 9 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    0, /* 9 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    Tcl_CreateFileHandler, /* 9 */
-#endif /* MACOSX */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#ifdef __WIN32__
+    NULL, /* 9 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 9 */
+#endif /* MAC_TCL */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     Tcl_DeleteFileHandler, /* 10 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    0, /* 10 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    Tcl_DeleteFileHandler, /* 10 */
-#endif /* MACOSX */
+#ifdef __WIN32__
+    NULL, /* 10 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 10 */
+#endif /* MAC_TCL */
     Tcl_SetTimer, /* 11 */
     Tcl_Sleep, /* 12 */
     Tcl_WaitForEvent, /* 13 */
@@ -819,7 +738,15 @@ const TclStubs tclStubs = {
     Tcl_DeleteHashEntry, /* 108 */
     Tcl_DeleteHashTable, /* 109 */
     Tcl_DeleteInterp, /* 110 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    Tcl_DetachPids, /* 111 */
+#endif /* UNIX */
+#ifdef __WIN32__
     Tcl_DetachPids, /* 111 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 111 */
+#endif /* MAC_TCL */
     Tcl_DeleteTimerHandler, /* 112 */
     Tcl_DeleteTrace, /* 113 */
     Tcl_DontCallWhenDeleted, /* 114 */
@@ -875,15 +802,15 @@ const TclStubs tclStubs = {
     Tcl_GetMaster, /* 164 */
     Tcl_GetNameOfExecutable, /* 165 */
     Tcl_GetObjResult, /* 166 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     Tcl_GetOpenFile, /* 167 */
 #endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-    0, /* 167 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    Tcl_GetOpenFile, /* 167 */
-#endif /* MACOSX */
+#ifdef __WIN32__
+    NULL, /* 167 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 167 */
+#endif /* MAC_TCL */
     Tcl_GetPathType, /* 168 */
     Tcl_Gets, /* 169 */
     Tcl_GetsObj, /* 170 */
@@ -904,7 +831,7 @@ const TclStubs tclStubs = {
     Tcl_IsSafe, /* 185 */
     Tcl_JoinPath, /* 186 */
     Tcl_LinkVar, /* 187 */
-    0, /* 188 */
+    NULL, /* 188 */
     Tcl_MakeFileChannel, /* 189 */
     Tcl_MakeSafe, /* 190 */
     Tcl_MakeTcpClientChannel, /* 191 */
@@ -913,7 +840,15 @@ const TclStubs tclStubs = {
     Tcl_NotifyChannel, /* 194 */
     Tcl_ObjGetVar2, /* 195 */
     Tcl_ObjSetVar2, /* 196 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
     Tcl_OpenCommandChannel, /* 197 */
+#endif /* UNIX */
+#ifdef __WIN32__
+    Tcl_OpenCommandChannel, /* 197 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 197 */
+#endif /* MAC_TCL */
     Tcl_OpenFileChannel, /* 198 */
     Tcl_OpenTcpClient, /* 199 */
     Tcl_OpenTcpServer, /* 200 */
@@ -923,7 +858,15 @@ const TclStubs tclStubs = {
     Tcl_PosixError, /* 204 */
     Tcl_QueueEvent, /* 205 */
     Tcl_Read, /* 206 */
+#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
+    Tcl_ReapDetachedProcs, /* 207 */
+#endif /* UNIX */
+#ifdef __WIN32__
     Tcl_ReapDetachedProcs, /* 207 */
+#endif /* __WIN32__ */
+#ifdef MAC_TCL
+    NULL, /* 207 */
+#endif /* MAC_TCL */
     Tcl_RecordAndEval, /* 208 */
     Tcl_RecordAndEvalObj, /* 209 */
     Tcl_RegisterChannel, /* 210 */
@@ -1001,7 +944,7 @@ const TclStubs tclStubs = {
     Tcl_UnstackChannel, /* 282 */
     Tcl_GetStackedChannel, /* 283 */
     Tcl_SetMainLoop, /* 284 */
-    0, /* 285 */
+    NULL, /* 285 */
     Tcl_AppendObjToObj, /* 286 */
     Tcl_CreateEncoding, /* 287 */
     Tcl_CreateThreadExitHandler, /* 288 */
@@ -1210,142 +1153,86 @@ const TclStubs tclStubs = {
     Tcl_Seek, /* 491 */
     Tcl_Tell, /* 492 */
     Tcl_ChannelWideSeekProc, /* 493 */
-    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 */
+    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_ChannelThreadActionProc, /* 554 */
-    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 */
+    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_PkgRequireProc, /* 573 */
-    Tcl_AppendObjToErrorInfo, /* 574 */
-    Tcl_AppendLimitedToObj, /* 575 */
-    Tcl_Format, /* 576 */
-    Tcl_AppendFormatToObj, /* 577 */
-    Tcl_ObjPrintf, /* 578 */
-    Tcl_AppendPrintfToObj, /* 579 */
-    Tcl_CancelEval, /* 580 */
-    Tcl_Canceled, /* 581 */
-    Tcl_CreatePipe, /* 582 */
-    Tcl_NRCreateCommand, /* 583 */
-    Tcl_NREvalObj, /* 584 */
-    Tcl_NREvalObjv, /* 585 */
-    Tcl_NRCmdSwap, /* 586 */
-    Tcl_NRAddCallback, /* 587 */
-    Tcl_NRCallObjProc, /* 588 */
-    Tcl_GetFSDeviceFromStat, /* 589 */
-    Tcl_GetFSInodeFromStat, /* 590 */
-    Tcl_GetModeFromStat, /* 591 */
-    Tcl_GetLinkCountFromStat, /* 592 */
-    Tcl_GetUserIdFromStat, /* 593 */
-    Tcl_GetGroupIdFromStat, /* 594 */
-    Tcl_GetDeviceTypeFromStat, /* 595 */
-    Tcl_GetAccessTimeFromStat, /* 596 */
-    Tcl_GetModificationTimeFromStat, /* 597 */
-    Tcl_GetChangeTimeFromStat, /* 598 */
-    Tcl_GetSizeFromStat, /* 599 */
-    Tcl_GetBlocksFromStat, /* 600 */
-    Tcl_GetBlockSizeFromStat, /* 601 */
-    Tcl_SetEnsembleParameterList, /* 602 */
-    Tcl_GetEnsembleParameterList, /* 603 */
-    Tcl_ParseArgsObjv, /* 604 */
-    Tcl_GetErrorLine, /* 605 */
-    Tcl_SetErrorLine, /* 606 */
-    Tcl_TransferResult, /* 607 */
-    Tcl_InterpActive, /* 608 */
-    Tcl_BackgroundException, /* 609 */
-    Tcl_ZlibDeflate, /* 610 */
-    Tcl_ZlibInflate, /* 611 */
-    Tcl_ZlibCRC32, /* 612 */
-    Tcl_ZlibAdler32, /* 613 */
-    Tcl_ZlibStreamInit, /* 614 */
-    Tcl_ZlibStreamGetCommandName, /* 615 */
-    Tcl_ZlibStreamEof, /* 616 */
-    Tcl_ZlibStreamChecksum, /* 617 */
-    Tcl_ZlibStreamPut, /* 618 */
-    Tcl_ZlibStreamGet, /* 619 */
-    Tcl_ZlibStreamClose, /* 620 */
-    Tcl_ZlibStreamReset, /* 621 */
-    Tcl_SetStartupScript, /* 622 */
-    Tcl_GetStartupScript, /* 623 */
-    Tcl_CloseEx, /* 624 */
-    Tcl_NRExprObj, /* 625 */
-    Tcl_NRSubstObj, /* 626 */
-    Tcl_LoadFile, /* 627 */
-    Tcl_FindSymbol, /* 628 */
-    Tcl_FSUnloadFile, /* 629 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index f569820..1ab7ff3 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -1,73 +1,69 @@
-/*
+/* 
  * tclStubLib.c --
  *
- *	Stub object that will be statically linked into extensions that want
+ *	Stub object that will be statically linked into extensions that wish
  *	to access Tcl.
  *
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  * Copyright (c) 1998 Paul Duffin.
  *
- * 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.
  */
 
 /*
- * We need to ensure that we use the stub macros so that this file contains no
- * references to any of the stub functions. This will make it possible to
- * build an extension that references Tcl_InitStubs but doesn't end up
+ * We need to ensure that we use the stub macros so that this file contains
+ * no references to any of the stub functions.  This will make it possible
+ * to build an extension that references Tcl_InitStubs but doesn't end up
  * including the rest of the stub functions.
  */
 
+#ifndef USE_TCL_STUBS
 #define USE_TCL_STUBS
+#endif
+#undef USE_TCL_STUB_PROCS
 
 #include "tclInt.h"
+#include "tclPort.h"
 
-MODULE_SCOPE const TclStubs *tclStubsPtr;
-MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
-MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
-MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
+/*
+ * Ensure that Tcl_InitStubs is built as an exported symbol.  The other stub
+ * functions should be built as non-exported symbols.
+ */
 
-const TclStubs *tclStubsPtr = NULL;
-const TclPlatStubs *tclPlatStubsPtr = NULL;
-const TclIntStubs *tclIntStubsPtr = NULL;
-const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
+TclStubs *tclStubsPtr = NULL;
+TclPlatStubs *tclPlatStubsPtr = NULL;
+TclIntStubs *tclIntStubsPtr = NULL;
+TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
 
-static const TclStubs *
-HasStubSupport(
-    Tcl_Interp *interp)
+static TclStubs *	HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
+
+static TclStubs *
+HasStubSupport (interp)
+    Tcl_Interp *interp;
 {
     Interp *iPtr = (Interp *) interp;
 
     if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
 	return iPtr->stubTable;
     }
+    interp->result = "This interpreter does not support stubs-enabled extensions.";
+    interp->freeProc = TCL_STATIC;
 
-    iPtr->result =
-	    (char *)"This interpreter does not support stubs-enabled extensions.";
-    iPtr->freeProc = TCL_STATIC;
     return NULL;
 }
 
 /*
- * Use our own isdigit to avoid linking to libc on windows
- */
-
-static int isDigit(const int c)
-{
-    return (c >= '0' && c <= '9');
-}
-
-/*
  *----------------------------------------------------------------------
  *
  * Tcl_InitStubs --
  *
- *	Tries to initialise the stub table pointers and ensures that the
- *	correct version of Tcl is loaded.
+ *	Tries to initialise the stub table pointers and ensures that
+ *	the correct version of Tcl is loaded.
  *
  * Results:
- *	The actual version of Tcl that satisfies the request, or NULL to
- *	indicate that an error occurred.
+ *	The actual version of Tcl that satisfies the request, or
+ *	NULL to indicate that an error occurred.
  *
  * Side effects:
  *	Sets the stub table pointers.
@@ -75,19 +71,23 @@ static int isDigit(const int c)
  *----------------------------------------------------------------------
  */
 
-MODULE_SCOPE const char *
-Tcl_InitStubs(
-    Tcl_Interp *interp,
-    const char *version,
-    int exact)
+#ifdef Tcl_InitStubs
+#undef Tcl_InitStubs
+#endif
+
+CONST char *
+Tcl_InitStubs (interp, version, exact)
+    Tcl_Interp *interp;
+    CONST char *version;
+    int exact;
 {
-    const char *actualVersion = NULL;
+    CONST char *actualVersion = NULL;
     ClientData pkgData = NULL;
 
     /*
-     * We can't optimize this check by caching tclStubsPtr because that
-     * prevents apps from being able to load/unload Tcl dynamically multiple
-     * times. [Bug 615304]
+     * We can't optimize this check by caching tclStubsPtr because
+     * that prevents apps from being able to load/unload Tcl dynamically
+     * multiple times. [Bug 615304]
      */
 
     tclStubsPtr = HasStubSupport(interp);
@@ -95,37 +95,11 @@ Tcl_InitStubs(
 	return NULL;
     }
 
-    actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
+    actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData);
     if (actualVersion == NULL) {
 	return NULL;
     }
-    if (exact) {
-	const char *p = version;
-	int count = 0;
-
-	while (*p) {
-	    count += !isDigit(*p++);
-	}
-	if (count == 1) {
-	    const char *q = actualVersion;
-
-	    p = version;
-	    while (*p && (*p == *q)) {
-		p++; q++;
-	    }
-	    if (*p) {
-		/* Construct error message */
-		Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
-		return NULL;
-	    }
-	} else {
-	    actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
-	    if (actualVersion == NULL) {
-		return NULL;
-	    }
-	}
-    }
-    tclStubsPtr = (TclStubs *) pkgData;
+    tclStubsPtr = (TclStubs*)pkgData;
 
     if (tclStubsPtr->hooks) {
 	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
@@ -136,14 +110,6 @@ Tcl_InitStubs(
 	tclIntStubsPtr = NULL;
 	tclIntPlatStubsPtr = NULL;
     }
-
+    
     return actualVersion;
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7631dee..b61213d 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1,18 +1,18 @@
-/*
+/* 
  * tclTest.c --
  *
- *	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.
+ *	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.
  *
  * 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
@@ -20,13 +20,10 @@
 #   define _USE_32BIT_TIME_T
 #endif
 
-#undef STATIC_BUILD
-#ifndef USE_TCL_STUBS
-#   define USE_TCL_STUBS
-#endif
+#define TCL_TEST
+#include <sys/stat.h>
 #include "tclInt.h"
-#include "tclOO.h"
-#include <math.h>
+#include "tclPort.h"
 
 /*
  * Required for Testregexp*Cmd
@@ -48,70 +45,56 @@
  */
 
 /*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Tcltest_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-EXTERN int		Tcltest_Init(Tcl_Interp *interp);
-EXTERN int		Tcltest_SafeInit(Tcl_Interp *interp);
-
-/*
- * 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)
-
 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 {
@@ -121,344 +104,372 @@ 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:
  */
 
-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(
+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_((
 			    ClientData clientData, Tcl_Interp *interp,
 			    int level, char *command, Tcl_CmdProc *cmdProc,
 			    ClientData cmdClientData, int argc,
-			    const char *argv[]);
-static void		CmdTraceProc(ClientData clientData,
+			    char **argv));
+static void		CmdTraceProc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, int level, char *command,
 			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
-			    int argc, const char *argv[]);
-static int		CreatedCommandProc(
+                            int argc, char **argv));
+static int		CreatedCommandProc _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp,
-			    int argc, const char **argv);
-static int		CreatedCommandProc2(
+			    int argc, CONST char **argv));
+static int		CreatedCommandProc2 _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp,
-			    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,
+			    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,
 			    Tcl_EncodingState *statePtr, char *dst,
 			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
-			    int *dstCharsPtr);
-static int		EncodingFromUtfProc(ClientData clientData,
-			    const char *src, int srcLen, int flags,
+			    int *dstCharsPtr));
+static int		EncodingFromUtfProc _ANSI_ARGS_((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(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);
-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,
+			    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,
 			    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_Obj *CONST objv[]));
+static int		TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    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		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(
+			    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_((
 			    ClientData dummy, Tcl_Interp *interp,
-			    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,
+			    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,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		TestMathFunc(ClientData clientData,
+			    Tcl_Obj *CONST objv[]));
+static int		TestMathFunc _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, Tcl_Value *args,
-			    Tcl_Value *resultPtr);
-static int		TestMathFunc2(ClientData clientData,
+			    Tcl_Value *resultPtr));
+static int		TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
 			    Tcl_Interp *interp, Tcl_Value *args,
-			    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		TestfinexitObjCmd(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int              TestparseargsCmd(ClientData dummy, Tcl_Interp *interp,
-                            int objc, Tcl_Obj *const objv[]);
-static int		TestparserObjCmd(ClientData dummy,
+			    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_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		TestparsevarObjCmd(ClientData dummy,
+			    Tcl_Obj *CONST objv[]));
+static int		TestparsevarObjCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		TestparsevarnameObjCmd(ClientData dummy,
+			    Tcl_Obj *CONST objv[]));
+static int		TestparsevarnameObjCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		TestregexpObjCmd(ClientData dummy,
+			    Tcl_Obj *CONST objv[]));
+static int		TestregexpObjCmd _ANSI_ARGS_((ClientData dummy,
 			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		TestreturnObjCmd(ClientData dummy,
+			    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_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static void		TestregexpXflags(const 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(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(
+			    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_((
 			    ClientData dummy, Tcl_Interp *interp,
-			    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(
+			    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_((
 			    ClientData clientData, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		TestGetIndexFromObjStructObjCmd(
+			    int objc, Tcl_Obj *CONST objv[]));
+static int              TestGetIndexFromObjStructObjCmd _ANSI_ARGS_((
 			    ClientData clientData, Tcl_Interp *interp,
-			    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 Tcl_FSStatProc TestReportStat;
-static Tcl_FSAccessProc TestReportAccess;
-static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel;
-static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory;
-static Tcl_FSChdirProc TestReportChdir;
-static Tcl_FSLstatProc TestReportLstat;
-static Tcl_FSCopyFileProc TestReportCopyFile;
-static Tcl_FSDeleteFileProc TestReportDeleteFile;
-static Tcl_FSRenameFileProc TestReportRenameFile;
-static Tcl_FSCreateDirectoryProc TestReportCreateDirectory;
-static Tcl_FSCopyDirectoryProc TestReportCopyDirectory;
-static Tcl_FSRemoveDirectoryProc TestReportRemoveDirectory;
-static Tcl_FSLoadFileProc TestReportLoadFile;
-static Tcl_FSLinkProc TestReportLink;
-static Tcl_FSFileAttrStringsProc TestReportFileAttrStrings;
-static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
-static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet;
-static Tcl_FSUtimeProc TestReportUtime;
-static Tcl_FSNormalizePathProc TestReportNormalizePath;
-static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
-static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
-static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
-
-static Tcl_FSStatProc SimpleStat;
-static Tcl_FSAccessProc SimpleAccess;
-static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
-static Tcl_FSListVolumesProc SimpleListVolumes;
-static Tcl_FSPathInFilesystemProc SimplePathInFilesystem;
-static Tcl_Obj *	SimpleRedirect(Tcl_Obj *pathPtr);
-static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
-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[]);
-static int		TestNRELevels(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		TestInterpResolverCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-
-static const Tcl_Filesystem testReportingFilesystem = {
+			    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_ ((
+			    Tcl_Interp *interp, Tcl_Obj *fileName,
+			    int mode, int permissions));
+static int		TestReportMatchInDirectory _ANSI_ARGS_ ((
+			    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[]));
+
+static Tcl_Filesystem testReportingFilesystem = {
     "reporting",
     sizeof(Tcl_Filesystem),
     TCL_FILESYSTEM_VERSION_1,
-    TestReportInFilesystem, /* path in */
-    TestReportDupInternalRep,
-    TestReportFreeInternalRep,
+    &TestReportInFilesystem, /* path in */
+    &TestReportDupInternalRep,
+    &TestReportFreeInternalRep,
     NULL, /* native to norm */
     NULL, /* convert to native */
-    TestReportNormalizePath,
+    &TestReportNormalizePath,
     NULL, /* path type */
     NULL, /* separator */
-    TestReportStat,
-    TestReportAccess,
-    TestReportOpenFileChannel,
-    TestReportMatchInDirectory,
-    TestReportUtime,
-    TestReportLink,
+    &TestReportStat,
+    &TestReportAccess,
+    &TestReportOpenFileChannel,
+    &TestReportMatchInDirectory,
+    &TestReportUtime,
+    &TestReportLink,
     NULL /* list volumes */,
-    TestReportFileAttrStrings,
-    TestReportFileAttrsGet,
-    TestReportFileAttrsSet,
-    TestReportCreateDirectory,
-    TestReportRemoveDirectory,
-    TestReportDeleteFile,
-    TestReportCopyFile,
-    TestReportRenameFile,
-    TestReportCopyDirectory,
-    TestReportLstat,
-    TestReportLoadFile,
+    &TestReportFileAttrStrings,
+    &TestReportFileAttrsGet,
+    &TestReportFileAttrsSet,
+    &TestReportCreateDirectory,
+    &TestReportRemoveDirectory, 
+    &TestReportDeleteFile,
+    &TestReportCopyFile,
+    &TestReportRenameFile,
+    &TestReportCopyDirectory, 
+    &TestReportLstat,
+    &TestReportLoadFile,
     NULL /* cwd */,
-    TestReportChdir
+    &TestReportChdir
 };
 
-static const Tcl_Filesystem simpleFilesystem = {
+static Tcl_Filesystem simpleFilesystem = {
     "simple",
     sizeof(Tcl_Filesystem),
     TCL_FILESYSTEM_VERSION_1,
-    SimplePathInFilesystem,
+    &SimplePathInFilesystem,
     NULL,
     NULL,
     /* No internal to normalized, since we don't create any
@@ -472,26 +483,26 @@ static const Tcl_Filesystem simpleFilesystem = {
     NULL,
     NULL,
     NULL,
-    SimpleStat,
-    SimpleAccess,
-    SimpleOpenFileChannel,
-    SimpleMatchInDirectory,
+    &SimpleStat,
+    &SimpleAccess,
+    &SimpleOpenFileChannel,
     NULL,
-    /* We choose not to support symbolic links inside our vfs's */
     NULL,
-    SimpleListVolumes,
+    /* We choose not to support symbolic links inside our vfs's */
     NULL,
+    &SimpleListVolumes,
     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 */
@@ -503,17 +514,26 @@ static const 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:
+ */
+
+extern int		TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
+extern int		TclThread_Init _ANSI_ARGS_((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.
@@ -522,176 +542,164 @@ static const Tcl_Filesystem simpleFilesystem = {
  */
 
 int
-Tcltest_Init(
-    Tcl_Interp *interp)		/* Interpreter for application. */
+Tcltest_Init(interp)
+    Tcl_Interp *interp;		/* Interpreter for application. */
 {
     Tcl_ValueType t3ArgTypes[2];
 
     Tcl_Obj *listPtr;
     Tcl_Obj **objv;
     int objc, index;
-    static const char *const specialOptions[] = {
+    static CONST char *specialOptions[] = {
 	"-appinitprocerror", "-appinitprocdeleteinterp",
-	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
+	"-appinitprocclosestderr", "-appinitprocsetrcfile", (char *) NULL
     };
 
-    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
-	return TCL_ERROR;
-    }
-    if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) {
-	return TCL_ERROR;
-    }
-    if (Tcl_OOInitStubs(interp) == NULL) {
-	return TCL_ERROR;
-    }
+#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) {
-	return TCL_ERROR;
+#endif
+        return TCL_ERROR;
     }
 
     /*
      * Create additional commands and math functions for testing Tcl.
      */
 
-    Tcl_CreateCommand(interp, "gettimes", GetTimesCmd, NULL, NULL);
-    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
-    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
+    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_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
-	    NULL, NULL);
+	    (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);
     Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
-	    TestGetIndexFromObjStructObjCmd, NULL, NULL);
-    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL);
+			 TestGetIndexFromObjStructObjCmd, (ClientData) 0,
+			 (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
-	    NULL, NULL);
-    Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
-	    NULL);
-    Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
-	    NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
-	    NULL, NULL);
-    Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
-	    NULL, NULL);
-    Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
-    Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
+	    (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);
     Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd,
-			 NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_DStringInit(&dstring);
-    Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, NULL,
-	    NULL);
+    Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testencoding", TestencodingObjCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testevalex", TestevalexObjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testevalobjv", TestevalobjvObjCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testevent", TesteventObjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand( interp, "testevent", TesteventObjCmd,
+			  (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
     Tcl_CreateCommand(interp, "testexithandler", TestexithandlerCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd,
-	    NULL, NULL);
-    Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd,
-	    NULL, NULL);
-    Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, NULL,
-	    NULL);
-    Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testfevent", TestfeventCmd, (ClientData) 0,
+            (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testfilelink", TestfilelinkCmd, 
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testfile", TestfileCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testhashsystemhash",
-	    TestHashSystemHashCmd, NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
-	    NULL, NULL);
-    Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testgetvarfullname",
-	    TestgetvarfullnameCmd, NULL, NULL);
+	    TestgetvarfullnameCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
-	    NULL, NULL);
-    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
-	    NULL);
-    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) 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);
     Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
-	    NULL, NULL);
+            (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
-	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
-    Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
-	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
+            (ClientData) TCL_LEAVE_ERR_MSG, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
-	    TestsetobjerrorcodeCmd, NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testsetobjerrorcode", 
+	    TestsetobjerrorcodeCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testnumutfchars",
-	    TestNumUtfCharsCmd, NULL, NULL);
+	    TestNumUtfCharsCmd, (ClientData) 0, 
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testtranslatefilename",
-	    TesttranslatefilenameCmd, NULL, NULL);
-    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
-    Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
-    Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
-    Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
-	    NULL);
+            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);
+    Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, (ClientData) 0,
+	    (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
-	    NULL, NULL);
+	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
-	    NULL, NULL);
+	    (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
     t3ArgTypes[0] = TCL_EITHER;
     t3ArgTypes[1] = TCL_EITHER;
     Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
-	    NULL);
-
-    Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
-	    NULL, NULL);
+	    (ClientData) 0);
 
-    if (TclObjTest_Init(interp) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    if (Procbodytest_Init(interp) != TCL_OK) {
-	return TCL_ERROR;
-    }
 #ifdef TCL_THREADS
     if (TclThread_Init(interp) != TCL_OK) {
 	return TCL_ERROR;
@@ -704,68 +712,42 @@ Tcltest_Init(
 
     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);
 }
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcltest_SafeInit --
- *
- *	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.
- *
- * Side effects:
- *	Depends on the startup script.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcltest_SafeInit(
-    Tcl_Interp *interp)		/* Interpreter for application. */
-{
-    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
-	return TCL_ERROR;
-    }
-    return Procbodytest_SafeInit(interp);
-}
 
 /*
  *----------------------------------------------------------------------
@@ -786,15 +768,16 @@ Tcltest_SafeInit(
 
 	/* ARGSUSED */
 static int
-TestasyncCmd(
-    ClientData dummy,			/* Not used. */
-    Tcl_Interp *interp,			/* Current interpreter. */
-    int argc,				/* Number of arguments. */
-    const char **argv)			/* Argument strings. */
+TestasyncCmd(dummy, interp, argc, argv)
+    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;
     static int nextId = 1;
+    char buf[TCL_INTEGER_SPACE];
 
     if (argc < 2) {
 	wrongNumArgs:
@@ -805,29 +788,26 @@ TestasyncCmd(
 	if (argc != 3) {
 	    goto wrongNumArgs;
 	}
-	asyncPtr = ckalloc(sizeof(TestAsyncHandler));
-	asyncPtr->command = ckalloc(strlen(argv[2]) + 1);
-	strcpy(asyncPtr->command, argv[2]);
-        Tcl_MutexLock(&asyncTestMutex);
+	asyncPtr = (TestAsyncHandler *) ckalloc(sizeof(TestAsyncHandler));
 	asyncPtr->id = nextId;
 	nextId++;
 	asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
-                                            INT2PTR(asyncPtr->id));
+		(ClientData) asyncPtr);
+	asyncPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
+	strcpy(asyncPtr->command, argv[2]);
 	asyncPtr->nextPtr = firstHandler;
 	firstHandler = asyncPtr;
-        Tcl_MutexUnlock(&asyncTestMutex);
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
+	TclFormatInt(buf, asyncPtr->id);
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "delete") == 0) {
 	if (argc == 2) {
-            Tcl_MutexLock(&asyncTestMutex);
 	    while (firstHandler != NULL) {
 		asyncPtr = firstHandler;
 		firstHandler = asyncPtr->nextPtr;
 		Tcl_AsyncDelete(asyncPtr->handler);
 		ckfree(asyncPtr->command);
-		ckfree(asyncPtr);
+		ckfree((char *) asyncPtr);
 	    }
-            Tcl_MutexUnlock(&asyncTestMutex);
 	    return TCL_OK;
 	}
 	if (argc != 3) {
@@ -836,7 +816,6 @@ TestasyncCmd(
 	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-        Tcl_MutexLock(&asyncTestMutex);
 	for (prevPtr = NULL, asyncPtr = firstHandler; asyncPtr != NULL;
 		prevPtr = asyncPtr, asyncPtr = asyncPtr->nextPtr) {
 	    if (asyncPtr->id != id) {
@@ -849,10 +828,9 @@ TestasyncCmd(
 	    }
 	    Tcl_AsyncDelete(asyncPtr->handler);
 	    ckfree(asyncPtr->command);
-	    ckfree(asyncPtr);
+	    ckfree((char *) asyncPtr);
 	    break;
 	}
-        Tcl_MutexUnlock(&asyncTestMutex);
     } else if (strcmp(argv[1], "mark") == 0) {
 	if (argc != 5) {
 	    goto wrongNumArgs;
@@ -868,68 +846,28 @@ TestasyncCmd(
 		break;
 	    }
 	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
+	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;
-	}
-	for (asyncPtr = firstHandler; asyncPtr != NULL;
-		asyncPtr = asyncPtr->nextPtr) {
-	    if (asyncPtr->id == id) {
-		Tcl_ThreadId threadID;
-		if (Tcl_CreateThread(&threadID, AsyncThreadProc,
-			INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
-			TCL_THREAD_NOFLAGS) != TCL_OK) {
-		    Tcl_SetResult(interp, "can't create thread", TCL_STATIC);
-		    return TCL_ERROR;
-		}
-		break;
-	    }
-	}
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, int, mark, or marklater", NULL);
+		"\": must be create, delete, int, or mark",
+		(char *) NULL);
 	return TCL_ERROR;
-#else /* !TCL_THREADS */
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, int, or mark", NULL);
-	return TCL_ERROR;
-#endif
     }
     return TCL_OK;
 }
 
 static int
-AsyncHandlerProc(
-    ClientData clientData,	/* If of TestAsyncHandler structure. 
-                                 * in global list. */
-    Tcl_Interp *interp,		/* Interpreter in which command was
+AsyncHandlerProc(clientData, interp, code)
+    ClientData clientData;	/* Pointer to TestAsyncHandler structure. */
+    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 = PTR2INT(clientData);
-    const char *listArgv[4], *cmd;
+    TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
+    CONST char *listArgv[4], *cmd;
     char string[TCL_INTEGER_SPACE];
 
-    Tcl_MutexLock(&asyncTestMutex);
-    for (asyncPtr = firstHandler; asyncPtr != NULL;
-         asyncPtr = asyncPtr->nextPtr) {
-        if (asyncPtr->id == id) break;
-    }
-    Tcl_MutexUnlock(&asyncTestMutex);
-
-    if (!asyncPtr) {
-        /* Woops - this one was deleted between the AsyncMark and now */
-        return TCL_OK;
-    }
-
     TclFormatInt(string, code);
     listArgv[0] = asyncPtr->command;
     listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp));
@@ -940,62 +878,23 @@ AsyncHandlerProc(
 	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(cmd);
+    ckfree((char *)cmd);
     return 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.
@@ -1008,17 +907,17 @@ AsyncThreadProc(
 
 	/* ARGSUSED */
 static int
-TestcmdinfoCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestcmdinfoCmd(dummy, interp, argc, argv)
+    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\"", NULL);
+		" option cmdName\"", (char *) NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
@@ -1035,43 +934,45 @@ TestcmdinfoCmd(
 	}
 	if (info.proc == CmdProc1) {
 	    Tcl_AppendResult(interp, "CmdProc1", " ",
-		    (char *) info.clientData, NULL);
+		    (char *) info.clientData, (char *) NULL);
 	} else if (info.proc == CmdProc2) {
 	    Tcl_AppendResult(interp, "CmdProc2", " ",
-		    (char *) info.clientData, NULL);
+		    (char *) info.clientData, (char *) NULL);
 	} else {
-	    Tcl_AppendResult(interp, "unknown", NULL);
+	    Tcl_AppendResult(interp, "unknown", (char *) NULL);
 	}
 	if (info.deleteProc == CmdDelProc1) {
 	    Tcl_AppendResult(interp, " CmdDelProc1", " ",
-		    (char *) info.deleteData, NULL);
+		    (char *) info.deleteData, (char *) NULL);
 	} else if (info.deleteProc == CmdDelProc2) {
 	    Tcl_AppendResult(interp, " CmdDelProc2", " ",
-		    (char *) info.deleteData, NULL);
+		    (char *) info.deleteData, (char *) NULL);
 	} else {
-	    Tcl_AppendResult(interp, " unknown", NULL);
+	    Tcl_AppendResult(interp, " unknown", (char *) NULL);
 	}
-	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL);
+	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName,
+	        (char *) NULL);
 	if (info.isNativeObjectProc) {
-	    Tcl_AppendResult(interp, " nativeObjectProc", NULL);
+	    Tcl_AppendResult(interp, " nativeObjectProc", (char *) NULL);
 	} else {
-	    Tcl_AppendResult(interp, " stringProc", NULL);
+	    Tcl_AppendResult(interp, " stringProc", (char *) NULL);
 	}
     } else if (strcmp(argv[1], "modify") == 0) {
 	info.proc = CmdProc2;
 	info.clientData = (ClientData) "new_command_data";
 	info.objProc = NULL;
-	info.objClientData = NULL;
+        info.objClientData = (ClientData) NULL;
 	info.deleteProc = CmdDelProc2;
 	info.deleteData = (ClientData) "new_delete_data";
 	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+	    Tcl_SetResult(interp, "0", TCL_STATIC);
 	} else {
-	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+	    Tcl_SetResult(interp, "1", TCL_STATIC);
 	}
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, get, or modify", NULL);
+		"\": must be create, delete, get, or modify",
+		(char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1079,31 +980,33 @@ TestcmdinfoCmd(
 
 	/*ARGSUSED*/
 static int
-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);
+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);
     return TCL_OK;
 }
 
 	/*ARGSUSED*/
 static int
-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);
+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);
     return TCL_OK;
 }
 
 static void
-CmdDelProc1(
-    ClientData clientData)	/* String to save. */
+CmdDelProc1(clientData)
+    ClientData clientData;		/* String to save. */
 {
     Tcl_DStringInit(&delString);
     Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
@@ -1111,8 +1014,8 @@ CmdDelProc1(
 }
 
 static void
-CmdDelProc2(
-    ClientData clientData)	/* String to save. */
+CmdDelProc2(clientData)
+    ClientData clientData;		/* String to save. */
 {
     Tcl_DStringInit(&delString);
     Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
@@ -1124,8 +1027,9 @@ CmdDelProc2(
  *
  * 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.
@@ -1138,11 +1042,11 @@ CmdDelProc2(
 
 	/* ARGSUSED */
 static int
-TestcmdtokenCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestcmdtokenCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
 {
     Tcl_Command token;
     int *l;
@@ -1150,20 +1054,20 @@ TestcmdtokenCmd(
 
     if (argc != 3) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option arg\"", NULL);
+		" option arg\"", (char *) NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
 	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
-		(ClientData) "original", NULL);
-	sprintf(buf, "%p", (void *)token);
+		(ClientData) "original", (Tcl_CmdDeleteProc *) 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],
-		    "\"", NULL);
+		    "\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
 
@@ -1171,12 +1075,12 @@ TestcmdtokenCmd(
 	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", NULL);
+		"\": must be create or name", (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1202,24 +1106,25 @@ TestcmdtokenCmd(
 
 	/* ARGSUSED */
 static int
-TestcmdtraceCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestcmdtraceCmd(dummy, interp, argc, argv)
+    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\"", NULL);
+		" option script\"", (char *) NULL);
 	return TCL_ERROR;
     }
 
     if (strcmp(argv[1], "tracetest") == 0) {
 	Tcl_DStringInit(&buffer);
-	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
+	cmdTrace = Tcl_CreateTrace(interp, 50000,
+	        (Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
 	result = Tcl_Eval(interp, argv[2]);
 	if (result == TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -1230,18 +1135,19 @@ TestcmdtraceCmd(
     } 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
-	 * TclNRExecuteByteCode.
+	 * 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, CmdTraceDeleteProc, NULL);
+	
+	cmdTrace = Tcl_CreateTrace(interp, 50000,
+	        (Tcl_CmdTraceProc *) CmdTraceDeleteProc, (ClientData) NULL);
 	Tcl_Eval(interp, argv[2]);
     } else if (strcmp(argv[1], "leveltest") == 0) {
 	Interp *iPtr = (Interp *) interp;
 	Tcl_DStringInit(&buffer);
-	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
-		&buffer);
+	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4,
+		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
 	result = Tcl_Eval(interp, argv[2]);
 	if (result == TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -1249,31 +1155,33 @@ TestcmdtraceCmd(
 	}
 	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);
-	t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
-	t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
+	t1 = Tcl_CreateTrace(interp, 1,
+		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
+	t2 = Tcl_CreateTrace(interp, 50000,
+		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
 	result = Tcl_Eval(interp, argv[2]);
 	if (result == TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -1284,26 +1192,28 @@ TestcmdtraceCmd(
 	Tcl_DStringFree(&buffer);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be tracetest, deletetest, doubletest or resulttest", NULL);
+			 "\": must be tracetest, deletetest, doubletest or resulttest",
+			 (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
 }
 
 static void
-CmdTraceProc(
-    ClientData clientData,	/* Pointer to buffer in which the
+CmdTraceProc(clientData, interp, level, command, cmdProc, cmdClientData,
+        argc, argv)
+    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. */
-    const char *argv[])		/* Argument strings. */
+    int argc;			/* Number of arguments. */
+    char **argv;		/* Argument strings. */
 {
     Tcl_DString *bufPtr = (Tcl_DString *) clientData;
     int i;
@@ -1318,49 +1228,49 @@ CmdTraceProc(
 }
 
 static void
-CmdTraceDeleteProc(
-    ClientData clientData,	/* Unused. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int level,			/* Current trace level. */
-    char *command,		/* The command being traced (after
+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
 				 * 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. */
-    const 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 TclNRExecuteByteCode 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 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, 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 ) );
 	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;
@@ -1368,10 +1278,10 @@ ObjTraceProc(
 }
 
 static void
-ObjTraceDeleteProc(
-    ClientData clientData)
+ObjTraceDeleteProc( clientData )
+    ClientData clientData;
 {
-    int *intPtr = (int *) clientData;
+    int * intPtr = (int *) clientData;
     *intPtr = 1;		/* Record that the trace was deleted */
 }
 
@@ -1380,11 +1290,11 @@ ObjTraceDeleteProc(
  *
  * 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.
@@ -1397,41 +1307,44 @@ ObjTraceDeleteProc(
  */
 
 static int
-TestcreatecommandCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestcreatecommandCmd(dummy, interp, argc, argv)
+    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\"", NULL);
+		" option\"", (char *) NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
 	Tcl_CreateCommand(interp, "test_ns_basic::createdcommand",
-		CreatedCommandProc, NULL, NULL);
+		CreatedCommandProc, (ClientData) NULL,
+		(Tcl_CmdDeleteProc *) 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, NULL, NULL);
+		CreatedCommandProc2, (ClientData) NULL,
+		(Tcl_CmdDeleteProc *) 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", NULL);
+		"\": must be create, delete, create2, or delete2",
+		(char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
 }
 
 static int
-CreatedCommandProc(
-    ClientData clientData,	/* String to return. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+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. */
 {
     Tcl_CmdInfo info;
     int found;
@@ -1440,20 +1353,20 @@ CreatedCommandProc(
 	    &info);
     if (!found) {
 	Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
-		NULL);
+	        (char *) NULL);
 	return TCL_ERROR;
     }
     Tcl_AppendResult(interp, "CreatedCommandProc in ",
-	    info.namespacePtr->fullName, NULL);
+	    info.namespacePtr->fullName, (char *) NULL);
     return TCL_OK;
 }
 
 static int
-CreatedCommandProc2(
-    ClientData clientData,	/* String to return. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+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. */
 {
     Tcl_CmdInfo info;
     int found;
@@ -1461,11 +1374,11 @@ CreatedCommandProc2(
     found = Tcl_GetCommandInfo(interp, "value:at:", &info);
     if (!found) {
 	Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
-		NULL);
+	        (char *) NULL);
 	return TCL_ERROR;
     }
     Tcl_AppendResult(interp, "CreatedCommandProc2 in ",
-	    info.namespacePtr->fullName, NULL);
+	    info.namespacePtr->fullName, (char *) NULL);
     return TCL_OK;
 }
 
@@ -1488,11 +1401,11 @@ CreatedCommandProc2(
 
 	/* ARGSUSED */
 static int
-TestdcallCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestdcallCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
 {
     int i, id;
 
@@ -1504,10 +1417,10 @@ TestdcallCmd(
 	}
 	if (id < 0) {
 	    Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc,
-		    (ClientData) INT2PTR(-id));
+		    (ClientData) (-id));
 	} else {
 	    Tcl_CallWhenDeleted(delInterp, DelCallbackProc,
-		    (ClientData) INT2PTR(id));
+		    (ClientData) id);
 	}
     }
     Tcl_DeleteInterp(delInterp);
@@ -1520,11 +1433,12 @@ TestdcallCmd(
  */
 
 static void
-DelCallbackProc(
-    ClientData clientData,	/* Numerical value to append to delString. */
-    Tcl_Interp *interp)		/* Interpreter being deleted. */
+DelCallbackProc(clientData, interp)
+    ClientData clientData;		/* Numerical value to append to
+					 * delString. */
+    Tcl_Interp *interp;			/* Interpreter being deleted. */
 {
-    int id = PTR2INT(clientData);
+    int id = (int) clientData;
     char buffer[TCL_INTEGER_SPACE];
 
     TclFormatInt(buffer, id);
@@ -1553,11 +1467,11 @@ DelCallbackProc(
 
 	/* ARGSUSED */
 static int
-TestdelCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestdelCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
 {
     DelCmd *dPtr;
     Tcl_Interp *slave;
@@ -1572,9 +1486,9 @@ TestdelCmd(
 	return TCL_ERROR;
     }
 
-    dPtr = ckalloc(sizeof(DelCmd));
+    dPtr = (DelCmd *) ckalloc(sizeof(DelCmd));
     dPtr->interp = interp;
-    dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1);
+    dPtr->deleteCmd = (char *) ckalloc((unsigned) (strlen(argv[3]) + 1));
     strcpy(dPtr->deleteCmd, argv[3]);
 
     Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
@@ -1583,30 +1497,30 @@ TestdelCmd(
 }
 
 static int
-DelCmdProc(
-    ClientData clientData,	/* String result to return. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+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. */
 {
     DelCmd *dPtr = (DelCmd *) clientData;
 
-    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
+    Tcl_AppendResult(interp, dPtr->deleteCmd, (char *) NULL);
     ckfree(dPtr->deleteCmd);
-    ckfree(dPtr);
+    ckfree((char *) dPtr);
     return TCL_OK;
 }
 
 static void
-DelDeleteProc(
-    ClientData clientData)	/* String command to evaluate. */
+DelDeleteProc(clientData)
+    ClientData clientData;		/* String command to evaluate. */
 {
-    DelCmd *dPtr = clientData;
+    DelCmd *dPtr = (DelCmd *) clientData;
 
     Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
     Tcl_ResetResult(dPtr->interp);
     ckfree(dPtr->deleteCmd);
-    ckfree(dPtr);
+    ckfree((char *) dPtr);
 }
 
 /*
@@ -1628,118 +1542,22 @@ DelDeleteProc(
  */
 
 static int
-TestdelassocdataCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestdelassocdataCmd(clientData, interp, argc, argv)
+    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\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " data_key\"", (char *) 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 --
@@ -1758,11 +1576,11 @@ TestdoubledigitsObjCmd(ClientData unused,
 
 	/* ARGSUSED */
 static int
-TestdstringCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestdstringCmd(dummy, interp, argc, argv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
 {
     int count;
 
@@ -1808,26 +1626,28 @@ TestdstringCmd(
 	} else if (strcmp(argv[2], "staticlarge") == 0) {
 	    Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
 	} else if (strcmp(argv[2], "free") == 0) {
-	    char *s = ckalloc(100);
-	    strcpy(s, "This is a malloc-ed string");
-	    Tcl_SetResult(interp, s, TCL_DYNAMIC);
+	    Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
+	    strcpy(interp->result, "This is a malloc-ed string");
 	} else if (strcmp(argv[2], "special") == 0) {
-	    char *s = (char*)ckalloc(100) + 16;
-	    strcpy(s, "This is a specially-allocated string");
-	    Tcl_SetResult(interp, s, SpecialFree);
+	    interp->result = (char *) ckalloc(100);
+	    interp->result += 4;
+	    interp->freeProc = SpecialFree;
+	    strcpy(interp->result, "This is a specially-allocated string");
 	} else {
 	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
 		    "\": must be staticsmall, staticlarge, free, or special",
-		    NULL);
+		    (char *) 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;
 	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring)));
+	TclFormatInt(buf, Tcl_DStringLength(&dstring));
+	Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(argv[1], "result") == 0) {
 	if (argc != 2) {
 	    goto wrongNumArgs;
@@ -1848,8 +1668,8 @@ TestdstringCmd(
 	Tcl_DStringStartSublist(&dstring);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be append, element, end, free, get, length, "
-		"result, trunc, or start", NULL);
+		"\": must be append, element, end, free, get, length, ",
+		"result, trunc, or start", (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1863,7 +1683,7 @@ TestdstringCmd(
 static void SpecialFree(blockPtr)
     char *blockPtr;			/* Block to free. */
 {
-    ckfree(blockPtr - 16);
+    ckfree(blockPtr - 4);
 }
 
 /*
@@ -1885,82 +1705,92 @@ static void SpecialFree(blockPtr)
 
 	/* ARGSUSED */
 static int
-TestencodingObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Tcl_Encoding encoding;
     int index, length;
-    const char *string;
+    char *string;
     TclEncoding *encodingPtr;
-    static const char *const optionStrings[] = {
-	"create",	"delete",	NULL
+    static CONST char *optionStrings[] = {
+	"create",	"delete",	"path",
+	NULL
     };
     enum options {
-	ENC_CREATE,	ENC_DELETE
+	ENC_CREATE,	ENC_DELETE,	ENC_PATH
     };
-
+    
     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 = 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 = ckalloc(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 = ckalloc(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;
+	    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;
 	}
-	encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
-	Tcl_FreeEncoding(encoding);
-	Tcl_FreeEncoding(encoding);
-	break;
     }
     return TCL_OK;
 }
-
-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. */
+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. */
 {
     int len;
     TclEncoding *encodingPtr;
@@ -1980,19 +1810,19 @@ EncodingToUtfProc(
     *dstCharsPtr = len;
     return TCL_OK;
 }
-
-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. */
+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. */
 {
     int len;
     TclEncoding *encodingPtr;
@@ -2012,16 +1842,16 @@ EncodingFromUtfProc(
     *dstCharsPtr = len;
     return TCL_OK;
 }
-
 static void
-EncodingFreeProc(
-    ClientData clientData)	/* ClientData associated with type. */
+EncodingFreeProc(clientData)
+    ClientData clientData;	/* ClientData associated with type. */
 {
-    TclEncoding *encodingPtr = clientData;
+    TclEncoding *encodingPtr;
 
-    ckfree(encodingPtr->toUtfCmd);
-    ckfree(encodingPtr->fromUtfCmd);
-    ckfree(encodingPtr);
+    encodingPtr = (TclEncoding *) clientData;
+    ckfree((char *) encodingPtr->toUtfCmd);
+    ckfree((char *) encodingPtr->fromUtfCmd);
+    ckfree((char *) encodingPtr);
 }
 
 /*
@@ -2042,31 +1872,60 @@ EncodingFreeProc(
  */
 
 static int
-TestevalexObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    int length, flags;
-    const char *script;
+    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;
+    }
 
     flags = 0;
     if (objc == 3) {
-	const char *global = Tcl_GetStringFromObj(objv[2], &length);
-	if (strcmp(global, "global") != 0) {
-	    Tcl_AppendResult(interp, "bad value \"", global,
-		    "\": must be global", NULL);
+	string = Tcl_GetStringFromObj(objv[2], &length);
+	if (strcmp(string, "global") != 0) {
+	    Tcl_AppendResult(interp, "bad value \"", string,
+		    "\": must be global", (char *) 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.
+     */
 
-    script = Tcl_GetStringFromObj(objv[1], &length);
-    return Tcl_EvalEx(interp, script, length, flags);
+    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;
 }
 
 /*
@@ -2087,17 +1946,17 @@ TestevalexObjCmd(
  */
 
 static int
-TestevalobjvObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     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;
@@ -2136,67 +1995,74 @@ TestevalobjvObjCmd(
  */
 
 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 *const 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 *const 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 ?arg ...?");
+    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 = 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;
+
 }
 
 /*
@@ -2206,49 +2072,49 @@ TesteventObjCmd(
  *
  *	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;
 }
 
@@ -2271,26 +2137,25 @@ TesteventProc(
  */
 
 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 */
-    const char *evNameStr;
-    Tcl_Obj *targetName;	/* Name of the event(s) to delete */
-    const 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;
@@ -2315,62 +2180,54 @@ TesteventDeleteProc(
  */
 
 static int
-TestexithandlerCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestexithandlerCmd(clientData, interp, argc, argv)
+    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\"", NULL);
-	return TCL_ERROR;
+                " create|delete value\"", (char *) 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) INT2PTR(value));
+		(ClientData) value);
     } else if (strcmp(argv[1], "delete") == 0) {
 	Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
-		(ClientData) INT2PTR(value));
+		(ClientData) value);
     } else {
 	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create or delete", NULL);
+		"\": must be create or delete", (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
 }
 
 static void
-ExitProcOdd(
-    ClientData clientData)	/* Integer value to print. */
+ExitProcOdd(clientData)
+    ClientData clientData;		/* Integer value to print. */
 {
     char buf[16 + TCL_INTEGER_SPACE];
-    size_t len;
 
-    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");
-    }
+    sprintf(buf, "odd %d\n", (int) clientData);
+    write(1, buf, strlen(buf));
 }
 
 static void
-ExitProcEven(
-    ClientData clientData)	/* Integer value to print. */
+ExitProcEven(clientData)
+    ClientData clientData;		/* Integer value to print. */
 {
     char buf[16 + TCL_INTEGER_SPACE];
-    size_t len;
 
-    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");
-    }
+    sprintf(buf, "even %d\n", (int) clientData);
+    write(1, buf, strlen(buf));
 }
 
 /*
@@ -2391,25 +2248,20 @@ ExitProcEven(
  */
 
 static int
-TestexprlongCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestexprlongCmd(clientData, interp, argc, argv)
+    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, argv[1], &exprResult);
+    result = Tcl_ExprLong(interp, "4+1", &exprResult);
     if (result != TCL_OK) {
-	return result;
+        return result;
     }
     sprintf(buf, ": %ld", exprResult);
     Tcl_AppendResult(interp, buf, NULL);
@@ -2434,11 +2286,11 @@ TestexprlongCmd(
  */
 
 static int
-TestexprlongobjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const *objv)	/* Argument objects. */
+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. */
 {
     long exprResult;
     char buf[4 + TCL_INTEGER_SPACE];
@@ -2451,7 +2303,7 @@ TestexprlongobjCmd(
     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);
@@ -2461,93 +2313,6 @@ TestexprlongobjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * 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.
@@ -2562,16 +2327,16 @@ TestexprdoubleobjCmd(
  */
 
 static int
-TestexprstringCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestexprstringCmd(clientData, interp, argc, argv)
+    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\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " expression\"", (char *) NULL);
+        return TCL_ERROR;
     }
     return Tcl_ExprString(interp, argv[1]);
 }
@@ -2581,8 +2346,9 @@ TestexprstringCmd(
  *
  * 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.
@@ -2594,11 +2360,11 @@ TestexprstringCmd(
  */
 
 static int
-TestfilelinkCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
     Tcl_Obj *contents;
 
@@ -2606,35 +2372,35 @@ TestfilelinkCmd(
 	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), NULL);
+	    Tcl_AppendResult(interp, "could not create link from \"", 
+		    Tcl_GetString(objv[1]), "\" to \"", 
+		    Tcl_GetString(objv[2]), "\": ", 
+		    Tcl_PosixError(interp), (char *) 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), NULL);
+	    Tcl_AppendResult(interp, "could not read link \"", 
+		    Tcl_GetString(objv[1]), "\": ", 
+		    Tcl_PosixError(interp), (char *) 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
 	 */
@@ -2661,22 +2427,22 @@ TestfilelinkCmd(
  */
 
 static int
-TestgetassocdataCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestgetassocdataCmd(clientData, interp, argc, argv)
+    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\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " data_key\"", (char *) 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;
 }
@@ -2699,21 +2465,25 @@ TestgetassocdataCmd(
  */
 
 static int
-TestgetplatformCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestgetplatformCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
 {
-    static const char *const platformStrings[] = { "unix", "mac", "windows" };
+    static CONST char *platformStrings[] = { "unix", "mac", "windows" };
     TclPlatformType *platform;
 
-    platform = TclGetPlatform();
-
+#ifdef __WIN32__
+    platform = TclWinGetPlatform();
+#else
+    platform = &tclPlatform;
+#endif
+    
     if (argc != 1) {
-	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-		NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+		(char *) NULL);
+        return TCL_ERROR;
     }
 
     Tcl_AppendResult(interp, platformStrings[*platform], NULL);
@@ -2740,22 +2510,22 @@ TestgetplatformCmd(
 
 	/* ARGSUSED */
 static int
-TestinterpdeleteCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestinterpdeleteCmd(dummy, interp, argc, argv)
+    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\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " path\"", (char *) NULL);
+        return TCL_ERROR;
     }
     slaveToDelete = Tcl_GetSlave(interp, argv[1]);
-    if (slaveToDelete == NULL) {
-	return TCL_ERROR;
+    if (slaveToDelete == (Tcl_Interp *) NULL) {
+        return TCL_ERROR;
     }
     Tcl_DeleteInterp(slaveToDelete);
     return TCL_OK;
@@ -2781,26 +2551,17 @@ TestinterpdeleteCmd(
 
 	/* ARGSUSED */
 static int
-TestlinkCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestlinkCmd(dummy, interp, argc, argv)
+    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;
@@ -2808,16 +2569,14 @@ TestlinkCmd(
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg arg arg arg arg arg arg arg arg arg arg arg"
-		" arg arg?\"", NULL);
+		" option ?arg arg arg arg arg?\"", (char *) NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "create") == 0) {
-	if (argc != 16) {
+	if (argc != 7) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
 		argv[0], " ", argv[1],
-		" intRO realRO boolRO stringRO wideRO charRO ucharRO shortRO"
-		" ushortRO uintRO longRO ulongRO floatRO uwideRO\"", NULL);
+		" intRO realRO boolRO stringRO wideRO\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
 	if (created) {
@@ -2826,15 +2585,6 @@ TestlinkCmd(
 	    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) {
@@ -2877,99 +2627,17 @@ TestlinkCmd(
 			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(NULL, realVar, buffer);
+	Tcl_PrintDouble((Tcl_Interp *) NULL, realVar, buffer);
 	Tcl_AppendElement(interp, buffer);
 	TclFormatInt(buffer, boolVar);
 	Tcl_AppendElement(interp, buffer);
@@ -2980,36 +2648,12 @@ TestlinkCmd(
 	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) {
-	int v;
-
-	if (argc != 16) {
+	if (argc != 7) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
 		    argv[0], " ", argv[1],
-		    " intValue realValue boolValue stringValue wideValue"
-		    " charValue ucharValue shortValue ushortValue uintValue"
-		    " longValue ulongValue floatValue uwideValue\"", NULL);
+		    " intValue realValue boolValue stringValue wideValue\"",
+		    (char *) NULL);
 	    return TCL_ERROR;
 	}
 	if (argv[2][0] != 0) {
@@ -3034,7 +2678,7 @@ TestlinkCmd(
 	    if (strcmp(argv[5], "-") == 0) {
 		stringVar = NULL;
 	    } else {
-		stringVar = ckalloc(strlen(argv[5]) + 1);
+		stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
 		strcpy(stringVar, argv[5]);
 	    }
 	}
@@ -3046,74 +2690,12 @@ TestlinkCmd(
 	    }
 	    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) {
-	int v;
-
-	if (argc != 16) {
+	if (argc != 7) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"",
 		    argv[0], " ", argv[1],
-		    " intValue realValue boolValue stringValue wideValue"
-		    " charValue ucharValue shortValue ushortValue uintValue"
-		    " longValue ulongValue floatValue uwideValue\"", NULL);
+		    "intValue realValue boolValue stringValue wideValue\"",
+		    (char *) NULL);
 	    return TCL_ERROR;
 	}
 	if (argv[2][0] != 0) {
@@ -3141,7 +2723,7 @@ TestlinkCmd(
 	    if (strcmp(argv[5], "-") == 0) {
 		stringVar = NULL;
 	    } else {
-		stringVar = ckalloc(strlen(argv[5]) + 1);
+		stringVar = (char *) ckalloc((unsigned) (strlen(argv[5]) + 1));
 		strcpy(stringVar, argv[5]);
 	    }
 	    Tcl_UpdateLinkedVar(interp, "string");
@@ -3155,77 +2737,10 @@ TestlinkCmd(
 	    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", NULL);
+		"\": should be create, delete, get, set, or update",
+		(char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -3249,20 +2764,20 @@ TestlinkCmd(
  */
 
 static int
-TestlocaleCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
     int index;
-    const char *locale;
+    char *locale;
 
-    static const char *const optionStrings[] = {
-	"ctype", "numeric", "time", "collate", "monetary",
+    static CONST char *optionStrings[] = {
+    	"ctype", "numeric", "time", "collate", "monetary", 
 	"all",	NULL
     };
-    static const int lcTypes[] = {
+    static CONST int lcTypes[] = {
 	LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
 	LC_ALL
     };
@@ -3275,7 +2790,7 @@ TestlocaleCmd(
 	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;
@@ -3312,14 +2827,14 @@ TestlocaleCmd(
 
 	/* ARGSUSED */
 static int
-TestMathFunc(
-    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, 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. */
 {
     resultPtr->type = TCL_INT;
-    resultPtr->intValue = PTR2INT(clientData);
+    resultPtr->intValue = (int) clientData;
     return TCL_OK;
 }
 
@@ -3342,25 +2857,26 @@ TestMathFunc(
 
 	/* ARGSUSED */
 static int
-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. */
+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. */
 {
     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) {
@@ -3381,10 +2897,10 @@ TestMathFunc2(
 	}
     } 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) {
@@ -3403,10 +2919,10 @@ TestMathFunc2(
 	}
     } 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) {
@@ -3449,11 +2965,11 @@ TestMathFunc2(
  */
 	/* ARGSUSED */
 static void
-CleanupTestSetassocdataTests(
-    ClientData clientData,	/* Data to be released. */
-    Tcl_Interp *interp)		/* Interpreter being deleted. */
+CleanupTestSetassocdataTests(clientData, interp)
+    ClientData clientData;		/* Data to be released. */
+    Tcl_Interp *interp;			/* Interpreter being deleted. */
 {
-    ckfree(clientData);
+    ckfree((char *) clientData);
 }
 
 /*
@@ -3474,13 +2990,13 @@ CleanupTestSetassocdataTests(
  */
 
 static int
-TestparserObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    const char *script;
+    char *script;
     int length, dummy;
     Tcl_Parse parse;
 
@@ -3530,13 +3046,13 @@ TestparserObjCmd(
  */
 
 static int
-TestexprparserObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    const char *script;
+    char *script;
     int length, dummy;
     Tcl_Parse parse;
 
@@ -3551,10 +3067,6 @@ TestexprparserObjCmd(
     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);
@@ -3591,70 +3103,68 @@ TestexprparserObjCmd(
  */
 
 static void
-PrintParse(
-    Tcl_Interp *interp,		/* Interpreter whose result is to be set to
+PrintParse(interp, parsePtr)
+    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;
-    const char *typeString;
+    char *typeString;
     Tcl_Token *tokenPtr;
     int i;
 
     objPtr = Tcl_GetObjResult(interp);
     if (parsePtr->commentSize > 0) {
-	Tcl_ListObjAppendElement(NULL, objPtr,
+	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
 		Tcl_NewStringObj(parsePtr->commentStart,
 			parsePtr->commentSize));
     } else {
-	Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj("-", 1));
+	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
+		Tcl_NewStringObj("-", 1));
     }
-    Tcl_ListObjAppendElement(NULL, objPtr,
+    Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
 	    Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize));
-    Tcl_ListObjAppendElement(NULL, objPtr,
+    Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
 	    Tcl_NewIntObj(parsePtr->numWords));
     for (i = 0; i < parsePtr->numTokens; i++) {
 	tokenPtr = &parsePtr->tokenPtr[i];
 	switch (tokenPtr->type) {
-	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;
+	    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(NULL, objPtr,
+	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
 		Tcl_NewStringObj(typeString, -1));
-	Tcl_ListObjAppendElement(NULL, objPtr,
+	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
 		Tcl_NewStringObj(tokenPtr->start, tokenPtr->size));
-	Tcl_ListObjAppendElement(NULL, objPtr,
+	Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
 		Tcl_NewIntObj(tokenPtr->numComponents));
     }
-    Tcl_ListObjAppendElement(NULL, objPtr,
+    Tcl_ListObjAppendElement((Tcl_Interp *) NULL, objPtr,
 	    Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize,
 	    -1));
 }
@@ -3677,13 +3187,14 @@ PrintParse(
  */
 
 static int
-TestparsevarObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    const char *value, *name, *termPtr;
+    CONST char *value;
+    CONST char *name, *termPtr;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "varName");
@@ -3718,13 +3229,13 @@ TestparsevarObjCmd(
  */
 
 static int
-TestparsevarnameObjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    const char *script;
+    char *script;
     int append, length, dummy;
     Tcl_Parse parse;
 
@@ -3767,10 +3278,10 @@ TestparsevarnameObjCmd(
  *
  * 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.
@@ -3783,23 +3294,23 @@ TestparsevarnameObjCmd(
 
 	/* ARGSUSED */
 static int
-TestregexpObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int i, ii, indices, stringLength, match, about;
     int hasxflags, cflags, eflags;
     Tcl_RegExp regExpr;
-    const char *string;
+    char *string;
     Tcl_Obj *objPtr;
     Tcl_RegExpInfo info;
-    static const char *const options[] = {
+    static CONST char *options[] = {
 	"-indices",	"-nocase",	"-about",	"-expanded",
 	"-line",	"-linestop",	"-lineanchor",
 	"-xflags",
-	"--",		NULL
+	"--",		(char *) NULL
     };
     enum options {
 	REGEXP_INDICES, REGEXP_NOCASE,	REGEXP_ABOUT,	REGEXP_EXPANDED,
@@ -3813,9 +3324,9 @@ TestregexpObjCmd(
     cflags = REG_ADVANCED;
     eflags = 0;
     hasxflags = 0;
-
+    
     for (i = 1; i < objc; i++) {
-	const char *name;
+	char *name;
 	int index;
 
 	name = Tcl_GetString(objv[i]);
@@ -3827,40 +3338,49 @@ TestregexpObjCmd(
 	    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,
-		"?-switch ...? exp string ?matchVar? ?subMatchVar ...?");
+		"?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
 	return TCL_ERROR;
     }
     objc -= i;
@@ -3877,6 +3397,7 @@ TestregexpObjCmd(
     if (regExpr == NULL) {
 	return TCL_ERROR;
     }
+    objPtr = objv[1];
 
     if (about) {
 	if (TclRegAbout(interp, regExpr) < 0) {
@@ -3885,7 +3406,6 @@ TestregexpObjCmd(
 	return TCL_OK;
     }
 
-    objPtr = objv[1];
     match = Tcl_RegExpExecObj(interp, regExpr, objPtr, 0 /* offset */,
 	    objc-2 /* nmatches */, eflags);
 
@@ -3895,13 +3415,13 @@ TestregexpObjCmd(
     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) {
-	    const char *varName;
-	    const char *value;
+	    char *varName;
+	    CONST char *value;
 	    int start, end;
 	    char resinfo[TCL_INTEGER_SPACE * 2];
 
@@ -3911,12 +3431,12 @@ TestregexpObjCmd(
 	    value = Tcl_SetVar(interp, varName, resinfo, 0);
 	    if (value == NULL) {
 		Tcl_AppendResult(interp, "couldn't set variable \"",
-			varName, "\"", NULL);
+			varName, "\"", (char *) NULL);
 		return TCL_ERROR;
 	    }
 	} else if (cflags & TCL_REG_CANMATCH) {
-	    const char *varName;
-	    const char *value;
+	    char *varName;
+	    CONST char *value;
 	    char resinfo[TCL_INTEGER_SPACE * 2];
 
 	    Tcl_RegExpGetInfo(regExpr, &info);
@@ -3925,7 +3445,7 @@ TestregexpObjCmd(
 	    value = Tcl_SetVar(interp, varName, resinfo, 0);
 	    if (value == NULL) {
 		Tcl_AppendResult(interp, "couldn't set variable \"",
-			varName, "\"", NULL);
+			varName, "\"", (char *) NULL);
 		return TCL_ERROR;
 	    }
 	}
@@ -3944,7 +3464,7 @@ TestregexpObjCmd(
     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) {
@@ -3961,10 +3481,10 @@ TestregexpObjCmd(
 	    }
 
 	    /*
-	     * 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--;
 	    }
@@ -3984,16 +3504,20 @@ TestregexpObjCmd(
 			info.matches[ii].end - 1);
 	    }
 	}
-	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
+	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);
 	    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;
 }
@@ -4016,68 +3540,86 @@ TestregexpObjCmd(
  */
 
 static void
-TestregexpXflags(
-    const 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(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 */
 {
-    int i, cflags, eflags;
+    int i;
+    int cflags;
+    int 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;
+	    }
 	}
     }
 
@@ -4088,37 +3630,6 @@ TestregexpXflags(
 /*
  *----------------------------------------------------------------------
  *
- * 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
@@ -4135,22 +3646,23 @@ TestreturnObjCmd(
  */
 
 static int
-TestsetassocdataCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
-{
-    char *buf, *oldData;
+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;
     Tcl_InterpDeleteProc *procPtr;
-
+    
     if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-		" data_key data_item\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " data_key data_item\"", (char *) NULL);
+        return TCL_ERROR;
     }
 
-    buf = ckalloc(strlen(argv[2]) + 1);
+    buf = ckalloc((unsigned) strlen(argv[2]) + 1);
     strcpy(buf, argv[2]);
 
     /*
@@ -4162,8 +3674,8 @@ TestsetassocdataCmd(
     if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
 	ckfree(oldData);
     }
-
-    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
+    
+    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, 
 	(ClientData) buf);
     return TCL_OK;
 }
@@ -4187,31 +3699,37 @@ TestsetassocdataCmd(
  */
 
 static int
-TestsetplatformCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestsetplatformCmd(clientData, interp, argc, argv)
+    ClientData clientData;		/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int argc;				/* Number of arguments. */
+    CONST char **argv;			/* Argument strings. */
 {
     size_t length;
     TclPlatformType *platform;
 
-    platform = TclGetPlatform();
-
+#ifdef __WIN32__
+    platform = TclWinGetPlatform();
+#else
+    platform = &tclPlatform;
+#endif
+    
     if (argc != 2) {
-	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
-		" platform\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
+                " platform\"", (char *) NULL);
+        return TCL_ERROR;
     }
 
     length = strlen(argv[1]);
     if (strncmp(argv[1], "unix", length) == 0) {
 	*platform = TCL_PLATFORM_UNIX;
+    } else if (strncmp(argv[1], "mac", length) == 0) {
+	*platform = TCL_PLATFORM_MAC;
     } else if (strncmp(argv[1], "windows", length) == 0) {
 	*platform = TCL_PLATFORM_WINDOWS;
     } else {
-	Tcl_AppendResult(interp, "unsupported platform: should be one of "
-		"unix, or windows", NULL);
+        Tcl_AppendResult(interp, "unsupported platform: should be one of ",
+		"unix, mac, or windows", (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -4236,17 +3754,17 @@ TestsetplatformCmd(
  */
 
 static int
-TeststaticpkgCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TeststaticpkgCmd(dummy, interp, argc, argv)
+    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\"", NULL);
+		argv[0], " pkgName safe loaded\"", (char *) NULL);
 	return TCL_ERROR;
     }
     if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
@@ -4255,15 +3773,15 @@ TeststaticpkgCmd(
     if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
 	return TCL_ERROR;
     }
-    tclStubsPtr->tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
-	    StaticInitProc, (safe) ? StaticInitProc : NULL);
+    Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc,
+	    (safe) ? StaticInitProc : NULL);
     return TCL_OK;
 }
 
 static int
-StaticInitProc(
-    Tcl_Interp *interp)		/* Interpreter in which package is supposedly
-				 * being loaded. */
+StaticInitProc(interp)
+    Tcl_Interp *interp;			/* Interpreter in which package
+					 * is supposedly being loaded. */
 {
     Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
     return TCL_OK;
@@ -4287,18 +3805,18 @@ StaticInitProc(
  */
 
 static int
-TesttranslatefilenameCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TesttranslatefilenameCmd(dummy, interp, argc, argv)
+    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\"", NULL);
+		argv[0], " path\"", (char *) NULL);
 	return TCL_ERROR;
     }
     result = Tcl_TranslateFileName(interp, argv[1], &buffer);
@@ -4329,17 +3847,17 @@ TesttranslatefilenameCmd(
 
 	/* ARGSUSED */
 static int
-TestupvarCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestupvarCmd(dummy, interp, argc, argv)
+    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\"", NULL);
+		argv[0], " level name ?name2? dest global\"", (char *) NULL);
 	return TCL_ERROR;
     }
 
@@ -4356,8 +3874,8 @@ TestupvarCmd(
 	} else if (strcmp(argv[5], "namespace") == 0) {
 	    flags = TCL_NAMESPACE_ONLY;
 	}
-	return Tcl_UpVar2(interp, argv[1], argv[2],
-		(argv[3][0] == 0) ? NULL : argv[3], argv[4],
+	return Tcl_UpVar2(interp, argv[1], argv[2], 
+		(argv[3][0] == 0) ? (char *) NULL : argv[3], argv[4],
 		flags);
     }
 }
@@ -4367,8 +3885,9 @@ TestupvarCmd(
  *
  * 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
@@ -4382,11 +3901,11 @@ TestupvarCmd(
 
 	/* ARGSUSED */
 static int
-TestseterrorcodeCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestseterrorcodeCmd(dummy, interp, argc, argv)
+    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);
@@ -4417,13 +3936,22 @@ TestseterrorcodeCmd(
 
 	/* ARGSUSED */
 static int
-TestsetobjerrorcodeCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1));
+    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);
     return TCL_ERROR;
 }
 
@@ -4446,11 +3974,11 @@ TestsetobjerrorcodeCmd(
 
 	/* ARGSUSED */
 static int
-TestfeventCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestfeventCmd(clientData, interp, argc, argv)
+    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;
@@ -4458,46 +3986,46 @@ TestfeventCmd(
 
     if (argc < 2) {
 	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option ?arg ...?", NULL);
+		" option ?arg arg ...?", (char *) NULL);
 	return TCL_ERROR;
     }
     if (strcmp(argv[1], "cmd") == 0) {
 	if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " cmd script", NULL);
+		    " cmd script", (char *) NULL);
 	    return TCL_ERROR;
 	}
-	if (interp2 != NULL) {
-	    code = Tcl_GlobalEval(interp2, argv[2]);
+        if (interp2 != (Tcl_Interp *) 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\"",
-		    NULL);
-	    return TCL_ERROR;
-	}
+            return code;
+        } else {
+            Tcl_AppendResult(interp,
+                    "called \"testfevent code\" before \"testfevent create\"",
+                    (char *) 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;
 }
 
@@ -4509,7 +4037,7 @@ TestfeventCmd(
  *	Calls the panic routine.
  *
  * Results:
- *	Always returns TCL_OK.
+ *      Always returns TCL_OK. 
  *
  * Side effects:
  *	May exit application.
@@ -4518,78 +4046,37 @@ TestfeventCmd(
  */
 
 static int
-TestpanicCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
-{
-    const char *argString;
-
+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;
+    
     /*
      *  Put the arguments into a var args structure
      *  Append all of the arguments together separated by spaces
      */
 
     argString = Tcl_Merge(argc-1, argv+1);
-    Tcl_Panic("%s", argString);
-    ckfree(argString);
-
+    panic(argString);
+    ckfree((char *)argString);
+ 
     return TCL_OK;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * TestfinexitObjCmd --
- *
- *	Calls a variant of [exit] including the full finalization path.
- *
- * Results:
- *	Error, or doesn't return.
- *
- * Side effects:
- *	Exits application.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestfinexitObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    int value;
-
-    if ((objc != 1) && (objc != 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
-	return TCL_ERROR;
-    }
-
-    if (objc == 1) {
-	value = 0;
-    } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    Tcl_Finalize();
-    TclpExit(value);
-    /*NOTREACHED*/
-    return TCL_ERROR;		/* Better not ever reach this! */
-}
-
 static int
-TestfileCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    Tcl_Obj *const argv[])	/* The argument objects. */
+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. */
 {
     int force, i, j, result;
     Tcl_Obj *error = NULL;
-    const char *subcmd;
-
+    char *subcmd;
+    
     if (argc < 3) {
 	return TCL_ERROR;
     }
@@ -4597,7 +4084,7 @@ TestfileCmd(
     force = 0;
     i = 2;
     if (strcmp(Tcl_GetString(argv[2]), "-force") == 0) {
-	force = 1;
+        force = 1;
 	i = 3;
     }
 
@@ -4606,30 +4093,30 @@ TestfileCmd(
     }
 
     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') {
@@ -4637,10 +4124,11 @@ TestfileCmd(
 	    }
 	    Tcl_DecrRefCount(error);
 	}
-	Tcl_AppendResult(interp, Tcl_ErrnoId(), NULL);
+	Tcl_AppendResult(interp, Tcl_ErrnoId(), (char *) NULL);
     }
 
-  end:
+    end:
+
     return result;
 }
 
@@ -4662,24 +4150,24 @@ TestfileCmd(
  */
 
 static int
-TestgetvarfullnameCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    const char *name, *arg;
+    char *name, *arg;
     int flags = 0;
     Tcl_Namespace *namespacePtr;
-    Tcl_CallFrame *framePtr;
+    Tcl_CallFrame frame;
     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]);
@@ -4690,29 +4178,30 @@ TestgetvarfullnameCmd(
     }
 
     /*
-     * 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", NULL,
-		TCL_LEAVE_ERR_MSG);
+	namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var",
+	        (Tcl_Namespace *) NULL, TCL_LEAVE_ERR_MSG);
 	if (namespacePtr == NULL) {
 	    return TCL_ERROR;
 	}
-	result = TclPushStackFrame(interp, &framePtr, namespacePtr,
-		/*isProcCallFrame*/ 0);
+	result = Tcl_PushCallFrame(interp, &frame, namespacePtr,
+                /*isProcCallFrame*/ 0);
 	if (result != TCL_OK) {
 	    return result;
 	}
     }
-
-    variable = Tcl_FindNamespaceVar(interp, name, NULL,
+    
+    variable = Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) NULL,
 	    (flags | TCL_LEAVE_ERR_MSG));
 
     if (flags == TCL_NAMESPACE_ONLY) {
-	TclPopStackFrame(interp);
+	Tcl_PopCallFrame(interp);
     }
     if (variable == (Tcl_Var) NULL) {
 	return TCL_ERROR;
@@ -4726,9 +4215,10 @@ TestgetvarfullnameCmd(
  *
  * 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.
@@ -4740,47 +4230,48 @@ TestgetvarfullnameCmd(
  */
 
 static int
-GetTimesCmd(
-    ClientData unused,		/* Unused. */
-    Tcl_Interp *interp,		/* The current interpreter. */
-    int argc,			/* The number of arguments. */
-    const char **argv)		/* The argument strings. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
     int i, n;
     double timePer;
     Tcl_Time start, stop;
-    Tcl_Obj *objPtr, **objv;
-    const char *s;
+    Tcl_Obj *objPtr;
+    Tcl_Obj **objv;
+    CONST char *s;
     char newString[TCL_INTEGER_SPACE];
 
     /* alloc & free 100000 times */
     fprintf(stderr, "alloc & free 100000 6 word items\n");
     Tcl_GetTime(&start);
     for (i = 0;  i < 100000;  i++) {
-	objPtr = ckalloc(sizeof(Tcl_Obj));
-	ckfree(objPtr);
+	objPtr = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
+	ckfree((char *) objPtr);
     }
     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 = ckalloc(5000 * sizeof(Tcl_Obj *));
+    objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *));
     Tcl_GetTime(&start);
     for (i = 0;  i < 5000;  i++) {
-	objv[i] = ckalloc(sizeof(Tcl_Obj));
+	objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
     }
     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);
     for (i = 0;  i < 5000;  i++) {
-	ckfree(objv[i]);
+	ckfree((char *) objv[i]);
     }
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
@@ -4795,7 +4286,7 @@ GetTimesCmd(
     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);
@@ -4806,7 +4297,7 @@ GetTimesCmd(
     Tcl_GetTime(&stop);
     timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
     fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
-    ckfree(objv);
+    ckfree((char *) objv);
 
     /* TclGetString 100000 times */
     fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
@@ -4833,7 +4324,7 @@ GetTimesCmd(
     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);
@@ -4896,7 +4387,7 @@ GetTimesCmd(
     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;
 }
@@ -4919,11 +4410,11 @@ GetTimesCmd(
  */
 
 static int
-NoopCmd(
-    ClientData unused,		/* Unused. */
-    Tcl_Interp *interp,		/* The current interpreter. */
-    int argc,			/* The number of arguments. */
-    const char **argv)		/* The argument strings. */
+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. */
 {
     return TCL_OK;
 }
@@ -4946,11 +4437,11 @@ NoopCmd(
  */
 
 static int
-NoopObjCmd(
-    ClientData unused,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
     return TCL_OK;
 }
@@ -4974,66 +4465,34 @@ NoopObjCmd(
 
 	/* ARGSUSED */
 static int
-TestsetCmd(
-    ClientData data,		/* Additional flags for Get/SetVar2. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+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. */
 {
-    int flags = PTR2INT(data);
-    const char *value;
+    int flags = (int) data;
+    CONST char *value;
 
     if (argc == 2) {
-	Tcl_SetResult(interp, "before get", TCL_STATIC);
-	value = Tcl_GetVar2(interp, argv[1], NULL, flags);
-	if (value == NULL) {
-	    return TCL_ERROR;
-	}
+        Tcl_SetResult(interp, "before get", TCL_STATIC);
+	value = Tcl_GetVar2(interp, argv[1], (char *) 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], 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?\"", 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;
-	}
+        value = Tcl_SetVar2(interp, argv[1], (char *) 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 elemName ?newValue?\"", NULL);
+		argv[0], " varName ?newValue?\"", (char *) NULL);
 	return TCL_ERROR;
     }
 }
@@ -5043,8 +4502,9 @@ Testset2Cmd(
  *
  * 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.
@@ -5057,17 +4517,16 @@ Testset2Cmd(
 
 	/* ARGSUSED */
 static int
-TestsaveresultCmd(
-    ClientData dummy,		/* Not used. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* The argument objects. */
+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. */
 {
-    Interp* iPtr = (Interp*) interp;
     int discard, result, index;
     Tcl_SavedResult state;
     Tcl_Obj *objPtr;
-    static const char *const optionStrings[] = {
+    static CONST char *optionStrings[] = {
 	"append", "dynamic", "free", "object", "small", NULL
     };
     enum options {
@@ -5080,7 +4539,7 @@ TestsaveresultCmd(
 
     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) {
@@ -5092,26 +4551,25 @@ TestsaveresultCmd(
 
     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, (char *)"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;
@@ -5131,20 +4589,19 @@ TestsaveresultCmd(
     }
 
     switch ((enum options) index) {
-    case RESULT_DYNAMIC: {
-	int present = iPtr->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;
 }
@@ -5166,8 +4623,8 @@ TestsaveresultCmd(
  */
 
 static void
-TestsaveresultFree(
-    char *blockPtr)
+TestsaveresultFree(blockPtr)
+    char *blockPtr;
 {
     freeCount++;
 }
@@ -5175,10 +4632,10 @@ TestsaveresultFree(
 /*
  *----------------------------------------------------------------------
  *
- * TestmainthreadCmd  --
+ * TeststatprocCmd  --
  *
- *	Implements the "testmainthread" cmd that is used to test the
- *	'Tcl_GetCurrentThread' API.
+ *	Implements the "testTclStatProc" cmd that is used to test the
+ *	'TclStatInsertProc' & 'TclStatDeleteProc' C Apis.
  *
  * Results:
  *	A standard Tcl result.
@@ -5190,21 +4647,219 @@ TestsaveresultFree(
  */
 
 static int
-TestmainthreadCmd(
-    ClientData dummy,		/* Not used. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+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. */
 {
-    if (argc == 1) {
-	Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
+    TclStatProc_ *proc;
+    int retVal;
 
-	Tcl_SetObjResult(interp, idObj);
-	return TCL_OK;
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option arg\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[2], "TclpStat") == 0) {
+	proc = PretendTclpStat;
+    } else if (strcmp(argv[2], "TestStatProc1") == 0) {
+	proc = TestStatProc1;
+    } else if (strcmp(argv[2], "TestStatProc2") == 0) {
+	proc = TestStatProc2;
+    } else if (strcmp(argv[2], "TestStatProc3") == 0) {
+	proc = TestStatProc3;
     } else {
-	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": ",
+		"must be TclpStat, ",
+		"TestStatProc1, TestStatProc2, or TestStatProc3",
+		(char *) 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);
+	    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);
+	return TCL_ERROR;
+    }
+
+    if (retVal == TCL_ERROR) {
+	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
+		"could not be ", argv[1], "ed", (char *) NULL);
+    }
+
+    return retVal;
+}
+
+static int PretendTclpStat(path, buf)
+    CONST char *path;
+    Tcl_StatBuf *buf;
+{
+    int ret;
+    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
+#ifdef TCL_WIDE_INT_IS_LONG
+    Tcl_IncrRefCount(pathPtr);
+    ret = TclpObjStat(pathPtr, buf);
+    Tcl_DecrRefCount(pathPtr);
+    return ret;
+#else /* TCL_WIDE_INT_IS_LONG */
+    Tcl_StatBuf realBuf;
+    Tcl_IncrRefCount(pathPtr);
+    ret = TclpObjStat(pathPtr, &realBuf);
+    Tcl_DecrRefCount(pathPtr);
+    if (ret != -1) {
+#   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
+
+	/*
+	 * Perform the result-buffer overflow check manually.
+	 *
+	 * 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
+		|| OUT_OF_RANGE(realBuf.st_blocks)
+#   endif
+	    ) {
+#   ifdef EOVERFLOW
+	    errno = EOVERFLOW;
+#   else
+#       ifdef EFBIG
+            errno = EFBIG;
+#       else
+#           error "what error should be returned for a value out of range?"
+#       endif
+#   endif
+	    return -1;
+	}
+
+#   undef OUT_OF_RANGE
+#   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...
+	 */
+
+	buf->st_mode    = realBuf.st_mode;
+	buf->st_ino     = (ino_t) realBuf.st_ino;
+	buf->st_dev     = realBuf.st_dev;
+	buf->st_rdev    = realBuf.st_rdev;
+	buf->st_nlink   = realBuf.st_nlink;
+	buf->st_uid     = realBuf.st_uid;
+	buf->st_gid     = realBuf.st_gid;
+	buf->st_size    = (off_t) realBuf.st_size;
+	buf->st_atime   = realBuf.st_atime;
+	buf->st_mtime   = realBuf.st_mtime;
+	buf->st_ctime   = realBuf.st_ctime;
+#   ifdef HAVE_ST_BLOCKS
+	buf->st_blksize = realBuf.st_blksize;
+	buf->st_blocks  = (blkcnt_t) realBuf.st_blocks;
+#   endif
+    }
+    return ret;
+#endif /* TCL_WIDE_INT_IS_LONG */
+}
+
+/* Be careful in the compares in these tests, since the Macintosh puts a  
+ * leading : in the beginning of non-absolute paths before passing them 
+ * into the file command procedures.
+ */
+
+static int
+TestStatProc1(path, buf)
+    CONST char *path;
+    Tcl_StatBuf *buf;
+{
+    memset(buf, 0, sizeof(Tcl_StatBuf));
+    buf->st_size = 1234;
+    return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestStatProc2(path, buf)
+    CONST char *path;
+    Tcl_StatBuf *buf;
+{
+    memset(buf, 0, sizeof(Tcl_StatBuf));
+    buf->st_size = 2345;
+    return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestStatProc3(path, buf)
+    CONST char *path;
+    Tcl_StatBuf *buf;
+{
+    memset(buf, 0, sizeof(Tcl_StatBuf));
+    buf->st_size = 3456;
+    return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmainthreadCmd  --
+ *
+ *	Implements the "testmainthread" cmd that is used to test the
+ *	'Tcl_GetCurrentThread' API.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+  if (argc == 1) {
+      Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
+      Tcl_SetObjResult(interp, idObj);
+      return TCL_OK;
+  } else {
+      Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+      return TCL_ERROR;
+  }
 }
 
 /*
@@ -5215,7 +4870,7 @@ TestmainthreadCmd(
  *	A main loop set by TestsetmainloopCmd below.
  *
  * Results:
- *	None.
+ * 	None.
  *
  * Side effects:
  *	Event handlers could do anything.
@@ -5251,11 +4906,11 @@ MainLoop(void)
  */
 
 static int
-TestsetmainloopCmd(
-    ClientData dummy,		/* Not used. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+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. */
 {
   exitMainLoop = 0;
   Tcl_SetMainLoop(MainLoop);
@@ -5280,11 +4935,11 @@ TestsetmainloopCmd(
  */
 
 static int
-TestexitmainloopCmd(
-    ClientData dummy,		/* Not used. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+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. */
 {
   exitMainLoop = 1;
   return TCL_OK;
@@ -5293,6 +4948,316 @@ TestexitmainloopCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * TestaccessprocCmd  --
+ *
+ *	Implements the "testTclAccessProc" cmd that is used to test the
+ *	'TclAccessInsertProc' & 'TclAccessDeleteProc' C Apis.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    TclAccessProc_ *proc;
+    int retVal;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option arg\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[2], "TclpAccess") == 0) {
+	proc = PretendTclpAccess;
+    } else if (strcmp(argv[2], "TestAccessProc1") == 0) {
+	proc = TestAccessProc1;
+    } else if (strcmp(argv[2], "TestAccessProc2") == 0) {
+	proc = TestAccessProc2;
+    } 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);
+	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);
+	    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);
+	return TCL_ERROR;
+    }
+
+    if (retVal == TCL_ERROR) {
+	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
+		"could not be ", argv[1], "ed", (char *) NULL);
+    }
+
+    return retVal;
+}
+
+static int PretendTclpAccess(path, mode)
+    CONST char *path;
+    int mode;
+{
+    int ret;
+    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
+    Tcl_IncrRefCount(pathPtr);
+    ret = TclpObjAccess(pathPtr, mode);
+    Tcl_DecrRefCount(pathPtr);
+    return ret;
+}
+
+static int
+TestAccessProc1(path, mode)
+    CONST char *path;
+    int mode;
+{
+    return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestAccessProc2(path, mode)
+    CONST char *path;
+    int mode;
+{
+    return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
+}
+
+
+static int
+TestAccessProc3(path, mode)
+    CONST char *path;
+    int mode;
+{
+    return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestopenfilechannelprocCmd  --
+ *
+ *	Implements the "testTclOpenFileChannelProc" cmd that is used to test the
+ *	'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C Apis.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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. */
+{
+    TclOpenFileChannelProc_ *proc;
+    int retVal;
+
+    if (argc != 3) {
+	Tcl_AppendResult(interp, "wrong # args: should be \"",
+		argv[0], " option arg\"", (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    if (strcmp(argv[2], "TclpOpenFileChannel") == 0) {
+	proc = PretendTclpOpenFileChannel;
+    } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) {
+	proc = TestOpenFileChannelProc1;
+    } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) {
+	proc = TestOpenFileChannelProc2;
+    } 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);
+	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);
+	    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);
+	return TCL_ERROR;
+    }
+
+    if (retVal == TCL_ERROR) {
+	Tcl_AppendResult(interp, "\"", argv[2], "\": ",
+		"could not be ", argv[1], "ed", (char *) 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? */
+{
+    Tcl_Channel ret;
+    int mode, seekFlag;
+    Tcl_Obj *pathPtr;
+    mode = TclGetOpenMode(interp, modeString, &seekFlag);
+    if (mode == -1) {
+	return NULL;
+    }
+    pathPtr = Tcl_NewStringObj(fileName, -1);
+    Tcl_IncrRefCount(pathPtr);
+    ret = TclpOpenFileChannel(interp, pathPtr, mode, permissions);
+    Tcl_DecrRefCount(pathPtr);
+    if (ret != NULL) {
+	if (seekFlag) {
+	    if (Tcl_Seek(ret, (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 \"",
+		      fileName, "\": ", 
+		      Tcl_PosixError(interp), (char *) NULL);
+		}
+		Tcl_Close(NULL, ret);
+		return NULL;
+	    }
+	}
+    }
+    return ret;
+}
+
+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";
+    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",
+		modeString, permissions));
+    } else {
+	Tcl_DStringFree(&ds);
+	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";
+    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",
+		modeString, permissions));
+    } else {
+	Tcl_DStringFree(&ds);
+	return (NULL);
+    }
+}
+
+
+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";
+    Tcl_DString ds;
+    
+    Tcl_DStringInit(&ds);
+    Tcl_JoinPath(1, &expectname, &ds);
+
+    if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
+	Tcl_DStringFree(&ds);
+	return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
+		modeString, permissions));
+    } else {
+	Tcl_DStringFree(&ds);
+	return (NULL);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TestChannelCmd --
  *
  *	Implements the Tcl "testchannel" debugging command and its
@@ -5309,13 +5274,13 @@ TestexitmainloopCmd(
 
 	/* ARGSUSED */
 static int
-TestChannelCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Interpreter for result. */
-    int argc,			/* Count of additional args. */
-    const char **argv)		/* Additional arg strings. */
+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. */
 {
-    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. */
@@ -5324,49 +5289,28 @@ TestChannelCmd(
     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..?\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " subcommand ?additional args..?\"", (char *) NULL);
+        return TCL_ERROR;
     }
     cmdName = argv[1];
     len = strlen(cmdName);
 
-    chanPtr = NULL;
+    chanPtr = (Channel *) NULL;
 
     if (argc > 2) {
-	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(curPtr);
-		    break;
-		}
-	    }
-	} else {
-	    chan = Tcl_GetChannel(interp, argv[2], &mode);
-	}
-	if (chan == (Tcl_Channel) NULL) {
-	    return TCL_ERROR;
-	}
-	chanPtr		= (Channel *) chan;
+        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 */
@@ -5374,350 +5318,329 @@ TestChannelCmd(
 	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)) {
-	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 = ckalloc(sizeof(TestChannel));
-	det->chan     = chan;
-	det->nextPtr  = firstDetached;
-	firstDetached = det;
-
-	return TCL_OK;
+        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;
     }
 
     if ((cmdName[0] == 'c') &&
 	    (strncmp(cmdName, "clearchannelhandlers", len) == 0)) {
-	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 (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 ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
-	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);
-
-	IOQueued = Tcl_OutputBuffered(chan);
-	TclFormatInt(buf, IOQueued);
-	Tcl_AppendElement(interp, buf);
-
-	TclFormatInt(buf, (int)Tcl_Tell(chan));
-	Tcl_AppendElement(interp, buf);
+        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);
 
-	TclFormatInt(buf, statePtr->refCount);
-	Tcl_AppendElement(interp, buf);
+        TclFormatInt(buf, statePtr->refCount);
+        Tcl_AppendElement(interp, buf);
 
-	return TCL_OK;
+        return TCL_OK;
     }
 
     if ((cmdName[0] == 'i') &&
-	    (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;
+            (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;
     }
 
     if ((cmdName[0] == 'i') && (strncmp(cmdName, "isshared", len) == 0)) {
-	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 (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 ((cmdName[0] == 'i') && (strncmp(cmdName, "isstandard", len) == 0)) {
 	if (argc != 3) {
-	    Tcl_AppendResult(interp, "channel name required", NULL);
+	    Tcl_AppendResult(interp, "channel name required", (char *) NULL);
 	    return TCL_ERROR;
 	}
-
+	
 	TclFormatInt(buf, Tcl_IsStandardChannel(chan));
-	Tcl_AppendResult(interp, buf, NULL);
+	Tcl_AppendResult(interp, buf, (char *) NULL);
 	return TCL_OK;
     }
 
     if ((cmdName[0] == 'm') && (strncmp(cmdName, "mode", len) == 0)) {
-	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 (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 ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "channel name required", NULL);
-	    return TCL_ERROR;
-	}
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
 
-	TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
-	Tcl_AppendResult(interp, buf, NULL);
-	return TCL_OK;
+        TclFormatInt(buf, (long) Tcl_GetChannelThread(chan));
+        Tcl_AppendResult(interp, buf, (char *) NULL);
+        return TCL_OK;
     }
 
     if ((cmdName[0] == 'n') && (strncmp(cmdName, "name", len) == 0)) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "channel name required", NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_AppendResult(interp, statePtr->channelName, NULL);
-	return TCL_OK;
+        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 ((cmdName[0] == 'o') && (strncmp(cmdName, "open", len) == 0)) {
-	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-	if (hTblPtr == NULL) {
-	    return TCL_OK;
-	}
-	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	     hPtr != NULL;
+        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)) {
-	    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", NULL);
-	    return TCL_ERROR;
-	}
+            (strncmp(cmdName, "outputbuffered", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
 
-	IOQueued = Tcl_OutputBuffered(chan);
-	TclFormatInt(buf, IOQueued);
-	Tcl_AppendResult(interp, buf, NULL);
-	return TCL_OK;
+        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;
     }
 
     if ((cmdName[0] == 'q') &&
-	    (strncmp(cmdName, "queuedcr", len) == 0)) {
-	if (argc != 3) {
-	    Tcl_AppendResult(interp, "channel name required", NULL);
-	    return TCL_ERROR;
-	}
+            (strncmp(cmdName, "queuedcr", len) == 0)) {
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required",
+                    (char *) NULL);
+            return TCL_ERROR;
+        }
 
-	Tcl_AppendResult(interp,
-		(statePtr->flags & INPUT_SAW_CR) ? "1" : "0", NULL);
-	return TCL_OK;
+        Tcl_AppendResult(interp,
+                (statePtr->flags & INPUT_SAW_CR) ? "1" : "0",
+                (char *) NULL);
+        return TCL_OK;
     }
 
     if ((cmdName[0] == 'r') && (strncmp(cmdName, "readable", len) == 0)) {
-	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
-	if (hTblPtr == NULL) {
-	    return TCL_OK;
-	}
-	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
-	     hPtr != NULL;
+        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);
+            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", NULL);
-	    return TCL_ERROR;
-	}
-
-	TclFormatInt(buf, statePtr->refCount);
-	Tcl_AppendResult(interp, buf, NULL);
-	return TCL_OK;
+        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;
     }
 
-    /*
-     * "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", NULL);
-	    return TCL_ERROR;
-	}
-
-	Tcl_SpliceChannel(chan);
-
-	Tcl_RegisterChannel(interp, chan);
-	Tcl_UnregisterChannel(NULL, chan);
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "channel name required", (char *) NULL);
+            return TCL_ERROR;
+        }
 
-	return TCL_OK;
+        Tcl_SpliceChannel(chan);
+        return TCL_OK;
     }
 
     if ((cmdName[0] == 't') && (strncmp(cmdName, "type", len) == 0)) {
-	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 (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 ((cmdName[0] == 'w') && (strncmp(cmdName, "writable", len) == 0)) {
-	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);
+        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);
 	    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)) {
@@ -5725,14 +5648,14 @@ TestChannelCmd(
 	 * Syntax: transform channel -command command
 	 */
 
-	if (argc != 5) {
+        if (argc != 5) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " transform channelId -command cmd\"", NULL);
-	    return TCL_ERROR;
-	}
+		    " transform channelId -command cmd\"", (char *) NULL);
+            return TCL_ERROR;
+        }
 	if (strcmp(argv[3], "-command") != 0) {
 	    Tcl_AppendResult(interp, "bad argument \"", argv[3],
-		    "\": should be \"-command\"", NULL);
+		    "\": should be \"-command\"", (char *) NULL);
 	    return TCL_ERROR;
 	}
 
@@ -5745,17 +5668,18 @@ TestChannelCmd(
 	 * Syntax: unstack channel
 	 */
 
-	if (argc != 3) {
+        if (argc != 3) {
 	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		    " unstack channel\"", NULL);
-	    return TCL_ERROR;
-	}
+		    " unstack channel\"", (char *) 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", NULL);
+    Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be ",
+            "cut, clearchannelhandlers, info, isshared, mode, open, "
+	    "readable, splice, writable, transform, unstack",
+            (char *) NULL);
     return TCL_ERROR;
 }
 
@@ -5764,8 +5688,8 @@ TestChannelCmd(
  *
  * 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.
@@ -5778,197 +5702,198 @@ TestChannelCmd(
 
 	/* ARGSUSED */
 static int
-TestChannelEventCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+TestChannelEventCmd(dummy, interp, argc, argv)
+    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?\"", NULL);
-	return TCL_ERROR;
+        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                " channelName cmd ?arg1? ?arg2?\"", (char *) NULL);
+        return TCL_ERROR;
     }
     chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
-    if (chanPtr == NULL) {
-	return TCL_ERROR;
+    if (chanPtr == (Channel *) 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\"", 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\"", (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;
 	} else {
-	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
-		    "\": must be readable, writable, or none", NULL);
-	    return TCL_ERROR;
-	}
-
-	esPtr = ckalloc(sizeof(EventScriptRecord));
-	esPtr->nextPtr = statePtr->scriptRecordPtr;
-	statePtr->scriptRecordPtr = esPtr;
+            Tcl_AppendResult(interp, "bad event name \"", argv[3],
+                    "\": must be readable, writable, or none", (char *) NULL);
+            return TCL_ERROR;
+        }
 
-	esPtr->chanPtr = chanPtr;
-	esPtr->interp = interp;
-	esPtr->mask = mask;
+        esPtr = (EventScriptRecord *) ckalloc((unsigned)
+                sizeof(EventScriptRecord));
+        esPtr->nextPtr = statePtr->scriptRecordPtr;
+        statePtr->scriptRecordPtr = esPtr;
+        
+        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\"", 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);
+        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);
 	     i++, esPtr = esPtr->nextPtr) {
 	    /* Empty loop body. */
-	}
-	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) &&
+        }
+        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) &&
 		     (prevEsPtr->nextPtr != esPtr);
 		 prevEsPtr = prevEsPtr->nextPtr) {
-		/* 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);
+                /* 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);
 	Tcl_DecrRefCount(esPtr->scriptPtr);
-	ckfree(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\"", NULL);
-	    return TCL_ERROR;
-	}
+        if (argc != 3) {
+            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+                    " channelName list\"", (char *) NULL);
+            return TCL_ERROR;
+        }
 	resultListPtr = Tcl_GetObjResult(interp);
-	for (esPtr = statePtr->scriptRecordPtr;
-	     esPtr != NULL;
+        for (esPtr = statePtr->scriptRecordPtr;
+	     esPtr != (EventScriptRecord *) 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\"", NULL);
-	    return TCL_ERROR;
-	}
-	for (esPtr = statePtr->scriptRecordPtr;
-	     esPtr != NULL;
+        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;
 	     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(esPtr);
-	}
-	statePtr->scriptRecordPtr = NULL;
-	return TCL_OK;
+            ckfree((char *) esPtr);
+        }
+        statePtr->scriptRecordPtr = (EventScriptRecord *) 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\"", 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);
+    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);
 	     i++, esPtr = esPtr->nextPtr) {
 	    /* Empty loop body. */
-	}
-	if (esPtr == NULL) {
-	    Tcl_AppendResult(interp, "bad event index ", argv[3],
-		    ": out of range", NULL);
-	    return TCL_ERROR;
-	}
+        }
+        if (esPtr == (EventScriptRecord *) NULL) {
+            Tcl_AppendResult(interp, "bad event index ", argv[3],
+                    ": out of range", (char *) 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", NULL);
-	    return TCL_ERROR;
-	}
+            Tcl_AppendResult(interp, "bad event name \"", argv[4],
+                    "\": must be readable, writable, or none", (char *) 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", NULL);
+    }    
+    Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
+            "add, delete, list, set, or removeall", (char *) NULL);
     return TCL_ERROR;
 }
 
@@ -5989,14 +5914,14 @@ TestChannelEventCmd(
  */
 
 static int
-TestWrongNumArgsObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int i, length;
-    const char *msg;
+    char *msg;
 
     if (objc < 3) {
 	/*
@@ -6006,7 +5931,7 @@ TestWrongNumArgsObjCmd(
 	Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
 	return TCL_ERROR;
     }
-
+    
     if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -6015,7 +5940,7 @@ TestWrongNumArgsObjCmd(
     if (length == 0) {
 	msg = NULL;
     }
-
+    
     if (i > objc - 3) {
 	/*
 	 * Asked for more arguments than were given.
@@ -6045,14 +5970,14 @@ TestWrongNumArgsObjCmd(
  */
 
 static int
-TestGetIndexFromObjStructObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const char *const ary[] = {
-	"a", "b", "c", "d", "e", "f", NULL, NULL
+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. */
+{
+    char *ary[] = {
+	"a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL
     };
     int idx,target;
 
@@ -6061,7 +5986,7 @@ TestGetIndexFromObjStructObjCmd(
 	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) {
@@ -6071,7 +5996,7 @@ TestGetIndexFromObjStructObjCmd(
 	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;
@@ -6085,9 +6010,9 @@ TestGetIndexFromObjStructObjCmd(
  *
  * 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.
@@ -6099,15 +6024,15 @@ TestGetIndexFromObjStructObjCmd(
  */
 
 static int
-TestFilesystemObjCmd(
-    ClientData dummy,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+TestFilesystemObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;
+    Tcl_Interp *interp;
+    int		objc;
+    Tcl_Obj	*CONST objv[];
 {
     int res, boolVal;
-    const char *msg;
-
+    char *msg;
+    
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
 	return TCL_ERROR;
@@ -6122,94 +6047,82 @@ TestFilesystemObjCmd(
 	res = Tcl_FSUnregister(&testReportingFilesystem);
 	msg = (res == TCL_OK) ? "unregistered" : "failed";
     }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
+    Tcl_SetResult(interp, msg, TCL_VOLATILE);
     return res;
 }
 
-static int
-TestReportInFilesystem(
-    Tcl_Obj *pathPtr,
-    ClientData *clientDataPtr)
+static int 
+TestReportInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
 {
-    static Tcl_Obj *lastPathPtr = NULL;
-    Tcl_Obj *newPathPtr;
-
+    static Tcl_Obj* lastPathPtr = NULL;
+    
     if (pathPtr == lastPathPtr) {
 	/* Reject all files second time around */
-	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;
+        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;
+	}
     }
-    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 *pathPtr)
-{
-    return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem);
+static Tcl_Obj* 
+TestReportGetNativePath(Tcl_Obj* pathObjPtr) {
+    return (Tcl_Obj*) Tcl_FSGetInternalRep(pathObjPtr, &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(
-    const char *cmd,
-    Tcl_Obj *path,
-    Tcl_Obj *arg2)
+TestReport(cmd, path, arg2)
+    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) {
@@ -6227,259 +6140,254 @@ TestReport(
 }
 
 static int
-TestReportStat(
-    Tcl_Obj *path,		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
+TestReportStat(path, buf)
+    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(
-    Tcl_Obj *path,		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
+TestReportLstat(path, buf)
+    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(
-    Tcl_Obj *path,		/* Path of file to access (in current CP). */
-    int mode)			/* Permission setting. */
+TestReportAccess(path, mode)
+    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(
-    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(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);
     return TclpOpenFileChannel(interp, TestReportGetNativePath(fileName),
-	    mode, permissions);
+				 mode, permissions);
 }
 
 static int
-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.
+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.
 				 * 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(
-    Tcl_Obj *dirName)
+TestReportChdir(dirName)
+    Tcl_Obj *dirName;
 {
-    TestReport("chdir", dirName, NULL);
+    TestReport("chdir",dirName,NULL);
     return Tcl_FSChdir(TestReportGetNativePath(dirName));
 }
-
 static int
-TestReportLoadFile(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Obj *fileName,		/* Name of the file containing the desired
+TestReportLoadFile(interp, fileName,  
+		   handlePtr, unloadProcPtr)
+    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(
-    Tcl_Obj *path,		/* Path of file to readlink or link */
-    Tcl_Obj *to,		/* Path of file to link to, or NULL */
-    int linkType)
+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;
 {
-    TestReport("link", path, to);
+    TestReport("link",path,to);
     return Tcl_FSLink(TestReportGetNativePath(path), to, linkType);
 }
-
 static int
-TestReportRenameFile(
-    Tcl_Obj *src,		/* Pathname of file or dir to be renamed
+TestReportRenameFile(src, dst)
+    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(
-    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(src, dst)
+    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(
-    Tcl_Obj *path)		/* Pathname of file to be removed (UTF-8). */
+TestReportDeleteFile(path)
+    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(
-    Tcl_Obj *path)		/* Pathname of directory to create (UTF-8). */
+TestReportCreateDirectory(path)
+    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(
-    Tcl_Obj *src,		/* Pathname of directory to be copied
+TestReportCopyDirectory(src, dst, errorPtr)
+    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(
-    Tcl_Obj *path,		/* Pathname of directory to be removed
+TestReportRemoveDirectory(path, recursive, errorPtr)
+    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 *const *
-TestReportFileAttrStrings(
-    Tcl_Obj *fileName,
-    Tcl_Obj **objPtrRef)
+static CONST char**
+TestReportFileAttrStrings(fileName, objPtrRef)
+    Tcl_Obj* fileName;
+    Tcl_Obj** objPtrRef;
 {
-    TestReport("fileattributestrings", fileName, NULL);
+    TestReport("fileattributestrings",fileName,NULL);
     return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef);
 }
-
 static int
-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. */
+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. */
 {
-    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(
-    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);
+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);
     return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
 }
-
 static int
-TestReportNormalizePath(
-    Tcl_Interp *interp,
-    Tcl_Obj *pathPtr,
-    int nextCheckpoint)
+TestReportNormalizePath(interp, pathPtr, nextCheckpoint)
+    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;
 }
 
-/*
- * 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.
+/* 
+ * 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.
  */
-
 static int
-TestSimpleFilesystemObjCmd(
-    ClientData dummy,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+TestSimpleFilesystemObjCmd(dummy, interp, objc, objv)
+    ClientData dummy;
+    Tcl_Interp *interp;
+    int		objc;
+    Tcl_Obj	*CONST objv[];
 {
     int res, boolVal;
-    const char *msg;
-
+    char *msg;
+    
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
 	return TCL_ERROR;
@@ -6490,138 +6398,129 @@ TestSimpleFilesystemObjCmd(
     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_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
+    Tcl_SetResult(interp, msg, TCL_VOLATILE);
     return res;
 }
 
-/*
- * Treats a file name 'simplefs:/foo' by using the file 'foo' in the current
- * (native) directory.
+/* 
+ * 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.
  */
-
-static Tcl_Obj *
-SimpleRedirect(
-    Tcl_Obj *pathPtr)		/* Name of file to copy. */
+static Tcl_Obj*
+SimpleCopy(pathPtr)
+    Tcl_Obj *pathPtr;                   /* Name of file to copy. */
 {
-    int len;
-    const char *str;
+    int res;
+    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_GetStringFromObj(pathPtr, &len);
-    if (len < 10 || strncmp(str, "simplefs:/", 10)) {
-	/* Probably shouldn't ever reach here */
-	Tcl_IncrRefCount(pathPtr);
-	return pathPtr;
-    }
+    str = Tcl_GetString(pathPtr);
     origPtr = Tcl_NewStringObj(str+10,-1);
     Tcl_IncrRefCount(origPtr);
-    return 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;
 
-    /* We only provide a new volume, therefore no mounts at all */
-    if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
-	return TCL_OK;
-    }
+    res = TclCrossFilesystemCopy(simpleInterpPtr, origPtr, tempPtr);
+    Tcl_DecrRefCount(origPtr);
 
-    /*
-     * 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);
-	}
+    if (res != TCL_OK) {
+	Tcl_FSDeleteFile(tempPtr);
+	Tcl_DecrRefCount(tempPtr);
+	return NULL;
     }
-    Tcl_DecrRefCount(origPtr);
-    Tcl_DecrRefCount(resPtr);
-    return res;
+    return tempPtr;
 }
 
 static Tcl_Channel
-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? */
+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? */
 {
     Tcl_Obj *tempPtr;
     Tcl_Channel chan;
-
+    
     if ((mode != 0) && !(mode & O_RDONLY)) {
-	Tcl_AppendResult(interp, "read-only", NULL);
+	Tcl_AppendResult(interp, "read-only", 
+		(char *) NULL);
 	return NULL;
     }
-
-    tempPtr = SimpleRedirect(pathPtr);
+    
+    tempPtr = SimpleCopy(pathPtr);
+    
+    if (tempPtr == NULL) {
+	return NULL;
+    }
+    
     chan = Tcl_FSOpenFileChannel(interp, tempPtr, "r", permissions);
-    Tcl_DecrRefCount(tempPtr);
+
+    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;
     return chan;
 }
 
 static int
-SimpleAccess(
-    Tcl_Obj *pathPtr,		/* Path of file to access (in current CP). */
-    int mode)			/* Permission setting. */
+SimpleAccess(pathPtr, mode)
+    Tcl_Obj *pathPtr;		/* Path of file to access (in current CP). */
+    int mode;                   /* Permission setting. */
 {
-    Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
-    int res = Tcl_FSAccess(tempPtr, mode);
-
-    Tcl_DecrRefCount(tempPtr);
-    return res;
+    /* All files exist */
+    return TCL_OK;
 }
 
 static int
-SimpleStat(
-    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
-    Tcl_StatBuf *bufPtr)	/* Filled with results of stat call. */
+SimpleStat(pathPtr, bufPtr)
+    Tcl_Obj *pathPtr;		/* Path of file to stat (in current CP). */
+    Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
 {
-    Tcl_Obj *tempPtr = SimpleRedirect(pathPtr);
-    int res = Tcl_FSStat(tempPtr, bufPtr);
-
-    Tcl_DecrRefCount(tempPtr);
-    return res;
+    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;
+    }
 }
 
-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;
 }
@@ -6629,17 +6528,15 @@ SimpleListVolumes(void)
 /*
  * Used to check correct string-length determining in Tcl_NumUtfChars
  */
-
 static int
-TestNumUtfCharsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+TestNumUtfCharsCmd(clientData, interp, objc, objv)
+    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);
 	}
@@ -6648,692 +6545,3 @@ TestNumUtfCharsCmd(
     }
     return TCL_OK;
 }
-
-/*
- * 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 const 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, 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, 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;
-
-	for (i=1 ; i<argc ; i++) {
-	    if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    total += val;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
-	return TCL_OK;
-    }
-}
-
-static int
-TestNRELevels(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-    static ptrdiff_t *refDepth = NULL;
-    ptrdiff_t depth;
-    Tcl_Obj *levels[6];
-    int i = 0;
-    NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
-
-    if (refDepth == NULL) {
-	refDepth = &depth;
-    }
-
-    depth = (refDepth - &depth);
-
-    levels[0] = Tcl_NewIntObj(depth);
-    levels[1] = Tcl_NewIntObj(iPtr->numLevels);
-    levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level);
-    levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level);
-    levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
-	    - iPtr->execEnvPtr->execStackPtr->stackWords);
-
-    while (cbPtr) {
-	i++;
-	cbPtr = cbPtr->nextPtr;
-    }
-    levels[5] = Tcl_NewIntObj(i);
-
-    Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
-    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(list1Ptr->bytes);
-	list1Ptr->bytes = NULL;
-    }
-
-    list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
-    Tcl_ListObjLength(NULL, list2Ptr, &len);
-    if (list2Ptr->bytes != NULL) {
-	ckfree(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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestparseargsCmd --
- *
- *	This procedure implements the "testparseargs" command. It is used to
- *	test that Tcl_ParseArgsObjv does indeed return the right number of
- *	arguments. In other words, that [Bug 3413857] was fixed properly.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-TestparseargsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Arguments. */
-{
-    static int foo = 0;
-    int count = objc;
-    Tcl_Obj **remObjv, *result[3];
-    Tcl_ArgvInfo argTable[] = {
-        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
-        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
-    };
-
-    foo = 0;
-    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
-        return TCL_ERROR;
-    }
-    result[0] = Tcl_NewIntObj(foo);
-    result[1] = Tcl_NewIntObj(count);
-    result[2] = Tcl_NewListObj(count, remObjv);
-    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
-    ckfree(remObjv);
-    return TCL_OK;
-}
-
-/**
- * Test harness for command and variable resolvers.
- */
-
-static int
-InterpCmdResolver(
-    Tcl_Interp *interp,
-    const char *name,
-    Tcl_Namespace *context,
-    int flags,
-    Tcl_Command *rPtr)
-{
-    Interp *iPtr = (Interp *) interp;
-    CallFrame *varFramePtr = iPtr->varFramePtr;
-    Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
-            varFramePtr->procPtr : NULL;
-    Namespace *ns2NsPtr = (Namespace *)
-            Tcl_FindNamespace(interp, "::ns2", NULL, 0);
-
-    if (procPtr && (procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr
-            || (ns2NsPtr && procPtr->cmdPtr->nsPtr == ns2NsPtr))) {
-        const char *callingCmdName =
-                Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);
-
-        if ((callingCmdName[0] == 'x') && (callingCmdName[1] == '\0')
-                && (name[0] == 'z') && (name[1] == '\0')) {
-            Tcl_Command sourceCmdPtr = Tcl_FindCommand(interp, "y", NULL,
-                    TCL_GLOBAL_ONLY);
-
-            if (sourceCmdPtr != NULL) {
-                *rPtr = sourceCmdPtr;
-                return TCL_OK;
-            }
-        }
-    }
-    return TCL_CONTINUE;
-}
-
-static int
-InterpVarResolver(
-    Tcl_Interp *interp,
-    const char *name,
-    Tcl_Namespace *context,
-    int flags,
-    Tcl_Var *rPtr)
-{
-    /*
-     * Don't resolve the variable; use standard rules.
-     */
-
-    return TCL_CONTINUE;
-}
-
-typedef struct MyResolvedVarInfo {
-    Tcl_ResolvedVarInfo vInfo;  /* This must be the first element. */
-    Tcl_Var var;
-    Tcl_Obj *nameObj;
-} MyResolvedVarInfo;
-
-static inline void
-HashVarFree(
-    Tcl_Var var)
-{
-    if (VarHashRefCount(var) < 2) {
-        ckfree(var);
-    } else {
-        VarHashRefCount(var)--;
-    }
-}
-
-static void
-MyCompiledVarFree(
-    Tcl_ResolvedVarInfo *vInfoPtr)
-{
-    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr;
-
-    Tcl_DecrRefCount(resVarInfo->nameObj);
-    if (resVarInfo->var) {
-        HashVarFree(resVarInfo->var);
-    }
-    ckfree(vInfoPtr);
-}
-
-#define TclVarHashGetValue(hPtr) \
-    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))
-
-static Tcl_Var
-MyCompiledVarFetch(
-    Tcl_Interp *interp,
-    Tcl_ResolvedVarInfo *vinfoPtr)
-{
-    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;
-    Tcl_Var var = resVarInfo->var;
-    int isNewVar;
-    Interp *iPtr = (Interp *) interp;
-    Tcl_HashEntry *hPtr;
-
-    if (var != NULL) {
-        if (!(((Var *) var)->flags & VAR_DEAD_HASH)) {
-            /*
-             * The cached variable is valid, return it.
-             */
-
-            return var;
-        }
-
-        /*
-         * The variable is not valid anymore. Clean it up.
-         */
-
-        HashVarFree(var);
-    }
-
-    hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable,
-            (char *) resVarInfo->nameObj, &isNewVar);
-    if (hPtr) {
-        var = (Tcl_Var) TclVarHashGetValue(hPtr);
-    } else {
-        var = NULL;
-    }
-    resVarInfo->var = var;
-
-    /*
-     * Increment the reference counter to avoid ckfree() of the variable in
-     * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree();
-     */
-
-    VarHashRefCount(var)++;
-    return var;
-}
-
-static int
-InterpCompiledVarResolver(
-    Tcl_Interp *interp,
-    const char *name,
-    int length,
-    Tcl_Namespace *context,
-    Tcl_ResolvedVarInfo **rPtr)
-{
-    if (*name == 'T') {
- 	MyResolvedVarInfo *resVarInfo = ckalloc(sizeof(MyResolvedVarInfo));
-
- 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
- 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
- 	resVarInfo->var = NULL;
- 	resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
- 	Tcl_IncrRefCount(resVarInfo->nameObj);
- 	*rPtr = &resVarInfo->vInfo;
- 	return TCL_OK;
-    }
-    return TCL_CONTINUE;
-}
-
-static int
-TestInterpResolverCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    static const char *const table[] = {
-        "down", "up", NULL
-    };
-    int idx;
-#define RESOLVER_KEY "testInterpResolver"
-
-    if (objc != 2) {
-        Tcl_WrongNumArgs(interp, 1, objv, "up|down");
- 	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT,
-            &idx) != TCL_OK) {
-        return TCL_ERROR;
-    }
-    switch (idx) {
-    case 1: /* up */
-        Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver,
-                InterpVarResolver, InterpCompiledVarResolver);
-        break;
-    case 0: /*down*/
-        if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) {
-            Tcl_AppendResult(interp, "could not remove the resolver scheme",
-                    NULL);
-            return TCL_ERROR;
-        }
-    }
-    return TCL_OK;
-}
-
-/*
- * 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 7494beb..a55704a 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1,86 +1,76 @@
-/*
+/* 
  * tclTestObj.c --
  *
- *	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.
+ *	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.
  *
  * 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.
  */
 
-#ifndef USE_TCL_STUBS
-#   define USE_TCL_STUBS
-#endif
 #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 *.
+ */
+
+#define NUMBER_OF_OBJECT_VARS 20
+static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS];
 
 /*
- * Forward declarations for functions defined later in this file:
+ * Forward declarations for procedures defined later in this file:
  */
 
-static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
-static int		GetVariableIndex(Tcl_Interp *interp,
-			    const char *string, int *indexPtr);
-static void		SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
-static int		TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
-static int		TestbooleanobjCmd(ClientData dummy,
+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		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[]);
+			    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,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *CONST objv[]));
 
 typedef struct TestString {
     int numChars;
-    int allocated;
-    int maxChars;
+    size_t allocated;
+    size_t uallocated;
     Tcl_UniChar unicode[2];
 } TestString;
-
-#define VARPTR_KEY "TCLOBJTEST_VARPTR"
-#define NUMBER_OF_OBJECT_VARS 20
 
-static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
-{
-    register int i;
-    Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
-    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
-	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
-    }
-    Tcl_DeleteAssocData(interp, VARPTR_KEY);
-    ckfree(varPtr);
-}
-
-static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
-{
-    Tcl_InterpDeleteProc *proc;
-
-    return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);
-}
 
 /*
  *----------------------------------------------------------------------
  *
  * TclObjTest_Init --
  *
- *	This function creates additional commands that are used to test the
+ *	This procedure creates additional commands that are used to test the
  *	Tcl object support.
  *
  * Results:
@@ -94,226 +84,154 @@ static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
  */
 
 int
-TclObjTest_Init(
-    Tcl_Interp *interp)
+TclObjTest_Init(interp)
+    Tcl_Interp *interp;
 {
     register int i;
-    /*
-     * 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 *.
-     */
-    Tcl_Obj **varPtr;
-
-    varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
-    if (!varPtr) {
-	return TCL_ERROR;
-    }
-    Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
+    
     for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
-	varPtr[i] = NULL;
+        varPtr[i] = NULL;
     }
-
-    Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
-	    NULL, NULL);
+	
     Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testconvertobj", TestconvertobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
-	    NULL, NULL);
-    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd,
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
-	    NULL, NULL);
+	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TestbignumobjCmd --
+ * TestbooleanobjCmd --
  *
- *	This function implmenets the "testbignumobj" command.  It is used
- *	to exercise the bignum Tcl object type implementation.
+ *	This procedure implements the "testbooleanobj" command.  It is used
+ *	to test the boolean Tcl object type implementation.
  *
  * Results:
- *	Returns a standard Tcl object result.
+ *	A standard Tcl object result.
  *
  * Side effects:
- *	Creates and frees bignum objects; converts objects to have bignum
- *	type.
+ *	Creates and frees boolean objects, and also converts objects to
+ *	have boolean type.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TestbignumobjCmd(
-    ClientData clientData,	/* unused */
-    Tcl_Interp *interp,		/* Tcl interpreter */
-    int objc,			/* Argument count */
-    Tcl_Obj *const objv[])	/* Argument vector */
+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. */
 {
-    const char *const subcmds[] = {
-	"set",	    "get",	"mult10",	"div10", NULL
-    };
-    enum options {
-	BIGNUM_SET, BIGNUM_GET,	BIGNUM_MULT10,	BIGNUM_DIV10
-    };
-    int index, varIndex;
-    const char *string;
-    mp_int bignumValue, newValue;
-    Tcl_Obj **varPtr;
+    int varIndex, boolValue;
+    char *index, *subCmd;
 
     if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
-	    &index) != TCL_OK) {
+	wrongNumArgs:
+	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
 	return TCL_ERROR;
     }
-    string = Tcl_GetString(objv[2]);
-    if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
+
+    index = Tcl_GetString(objv[2]);
+    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
     }
-    varPtr = GetVarPtr(interp);
 
-    switch (index) {
-    case BIGNUM_SET:
+    subCmd = Tcl_GetString(objv[1]);
+    if (strcmp(subCmd, "set") == 0) {
 	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "var value");
-	    return TCL_ERROR;
-	}
-	string = Tcl_GetString(objv[3]);
-	if (mp_init(&bignumValue) != MP_OKAY) {
-	    Tcl_SetObjResult(interp,
-		    Tcl_NewStringObj("error in mp_init", -1));
-	    return TCL_ERROR;
+	    goto wrongNumArgs;
 	}
-	if (mp_read_radix(&bignumValue, string, 10) != MP_OKAY) {
-	    mp_clear(&bignumValue);
-	    Tcl_SetObjResult(interp,
-		    Tcl_NewStringObj("error in mp_read_radix", -1));
+	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),
+	 * 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_SetBignumObj(varPtr[varIndex], &bignumValue);
+	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
-	}
-	break;
-
-    case BIGNUM_GET:
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
-	    return TCL_ERROR;
+	    SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
-	    return TCL_ERROR;
-	}
-	break;
-
-    case BIGNUM_MULT10:
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "get") == 0) {
 	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
-	    return TCL_ERROR;
-	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
-		&bignumValue) != TCL_OK) {
-	    return TCL_ERROR;
+	    goto wrongNumArgs;
 	}
-	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));
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	mp_clear(&bignumValue);
-	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
-	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
-	}
-	break;
-
-    case BIGNUM_DIV10:
+	Tcl_SetObjResult(interp, varPtr[varIndex]);
+    } else if (strcmp(subCmd, "not") == 0) {
 	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
-	    return TCL_ERROR;
-	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
-	    return TCL_ERROR;
+	    goto wrongNumArgs;
 	}
-	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
-		&bignumValue) != TCL_OK) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    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));
+	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
+				  &boolValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	mp_clear(&bignumValue);
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
+	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
+	    SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
 	}
+	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;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TestbooleanobjCmd --
+ * TestconvertobjCmd --
  *
- *	This function implements the "testbooleanobj" command.  It is used to
- *	test the boolean Tcl object type implementation.
+ *	This procedure implements the "testconvertobj" command. It is used
+ *	to test converting objects to new types.
  *
  * Results:
  *	A standard Tcl object result.
  *
  * Side effects:
- *	Creates and frees boolean objects, and also converts objects to
- *	have boolean type.
+ *	Converts objects to new types.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TestbooleanobjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    int varIndex, boolValue;
-    const char *index, *subCmd;
-    Tcl_Obj **varPtr;
+    char *subCmd;
+    char buf[20];
 
     if (objc < 3) {
 	wrongNumArgs:
@@ -321,65 +239,22 @@ TestbooleanobjCmd(
 	return TCL_ERROR;
     }
 
-    index = Tcl_GetString(objv[2]);
-    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    varPtr = GetVarPtr(interp);
-
     subCmd = Tcl_GetString(objv[1]);
-    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 (strcmp(subCmd, "double") == 0) {
+	double d;
 
-	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
-	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
-	}
-	Tcl_SetObjResult(interp, varPtr[varIndex]);
-    } else if (strcmp(subCmd, "get") == 0) {
-	if (objc != 3) {
-	    goto wrongNumArgs;
-	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, varPtr[varIndex]);
-    } else if (strcmp(subCmd, "not") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
-				  &boolValue) != TCL_OK) {
+	if (Tcl_GetDoubleFromObj(interp, objv[2], &d) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
-	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
-	}
-	Tcl_SetObjResult(interp, varPtr[varIndex]);
+	sprintf(buf, "%f", d);
+        Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad option \"", Tcl_GetString(objv[1]),
-		"\": must be set, get, or not", NULL);
+		"\": must be double", (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -390,8 +265,8 @@ TestbooleanobjCmd(
  *
  * TestdoubleobjCmd --
  *
- *	This function implements the "testdoubleobj" command.  It is used to
- *	test the double-precision floating point Tcl object type
+ *	This procedure implements the "testdoubleobj" command.  It is used
+ *	to test the double-precision floating point Tcl object type
  *	implementation.
  *
  * Results:
@@ -405,25 +280,22 @@ TestbooleanobjCmd(
  */
 
 static int
-TestdoubleobjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int varIndex;
     double doubleValue;
-    const char *index, *subCmd, *string;
-    Tcl_Obj **varPtr;
-
+    char *index, *subCmd, *string;
+	
     if (objc < 3) {
 	wrongNumArgs:
 	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
 	return TCL_ERROR;
     }
 
-    varPtr = GetVarPtr(interp);
-
     index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
@@ -442,22 +314,22 @@ TestdoubleobjCmd(
 	/*
 	 * 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".
 	 */
 
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue));
+	    SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "get") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -465,7 +337,7 @@ TestdoubleobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
@@ -473,32 +345,32 @@ TestdoubleobjCmd(
 	    return TCL_ERROR;
 	}
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue * 10.0);
+	    Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue * 10.0));
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue * 10.0));
+	    SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue * 10.0) ));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "div10") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
-		&doubleValue) != TCL_OK) {
+				 &doubleValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue / 10.0);
+	    Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
+	    SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad option \"", Tcl_GetString(objv[1]),
-		"\": must be set, get, mult10, or div10", NULL);
+		"\": must be set, get, mult10, or div10", (char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -509,7 +381,7 @@ TestdoubleobjCmd(
  *
  * TestindexobjCmd --
  *
- *	This function implements the "testindexobj" command. It is used to
+ *	This procedure implements the "testindexobj" command. It is used to
  *	test the index Tcl object type implementation.
  *
  * Results:
@@ -523,41 +395,42 @@ TestdoubleobjCmd(
  */
 
 static int
-TestindexobjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int allowAbbrev, index, index2, setError, i, result;
-    const char **argv;
-    static const char *const tablePtr[] = {"a", "b", "check", NULL};
+    CONST char **argv;
+    static CONST char *tablePtr[] = {"a", "b", "check", (char *) NULL};
     /*
      * Keep this structure declaration in sync with tclIndexObj.c
      */
     struct IndexRep {
-	void *tablePtr;		/* Pointer to the table of strings. */
-	int offset;		/* Offset between table entries. */
-	int index;		/* Selected index into table. */
+	VOID *tablePtr;			/* Pointer to the table of strings */
+	int offset;			/* Offset between table entries */
+	int index;			/* Selected index into table. */
     };
     struct IndexRep *indexRep;
 
     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(NULL, objv[1], tablePtr, "token", 0, &index);
-	indexRep = objv[1]->internalRep.otherValuePtr;
+	Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1], tablePtr,
+		"token", 0, &index);
+	indexRep = (struct IndexRep *) objv[1]->internalRep.otherValuePtr;
 	indexRep->index = index2;
-	result = Tcl_GetIndexFromObj(NULL, objv[1],
+	result = Tcl_GetIndexFromObj((Tcl_Interp *) NULL, objv[1],
 		tablePtr, "token", 0, &index);
 	if (result == TCL_OK) {
 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
@@ -577,30 +450,31 @@ TestindexobjCmd(
 	return TCL_ERROR;
     }
 
-    argv = ckalloc((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 = objv[3]->internalRep.otherValuePtr;
-	if (indexRep->tablePtr == (void *) argv) {
-	    TclFreeIntRep(objv[3]);
+    if ( objv[3]->typePtr != NULL
+	 && !strcmp( "index", objv[3]->typePtr->name ) ) {
+	indexRep = (struct IndexRep *) objv[3]->internalRep.otherValuePtr;
+	if (indexRep->tablePtr == (VOID *) argv) {
+	    objv[3]->typePtr->freeIntRepProc(objv[3]);
+	    objv[3]->typePtr = NULL;
 	}
     }
 
     result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
 	    argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
-    ckfree(argv);
+    ckfree((char *) argv);
     if (result == TCL_OK) {
 	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
     }
@@ -612,7 +486,7 @@ TestindexobjCmd(
  *
  * TestintobjCmd --
  *
- *	This function implements the "testintobj" command. It is used to
+ *	This procedure implements the "testintobj" command. It is used to
  *	test the int Tcl object type implementation.
  *
  * Results:
@@ -626,24 +500,22 @@ TestindexobjCmd(
  */
 
 static int
-TestintobjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int intValue, varIndex, i;
     long longValue;
-    const char *index, *subCmd, *string;
-    Tcl_Obj **varPtr;
-
+    char *index, *subCmd, *string;
+	
     if (objc < 3) {
 	wrongNumArgs:
 	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
 	return TCL_ERROR;
     }
 
-    varPtr = GetVarPtr(interp);
     index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
@@ -663,15 +535,15 @@ TestintobjCmd(
 	/*
 	 * 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".
 	 */
 
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetIntObj(varPtr[varIndex], intValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
+	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
@@ -686,7 +558,7 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetIntObj(varPtr[varIndex], intValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
+	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
 	}
     } else if (strcmp(subCmd, "setlong") == 0) {
 	if (objc != 4) {
@@ -700,7 +572,7 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetLongObj(varPtr[varIndex], intValue);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
+	    SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "setmaxlong") == 0) {
@@ -711,25 +583,25 @@ TestintobjCmd(
 	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
 	    Tcl_SetLongObj(varPtr[varIndex], maxLong);
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong));
+	    SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
 	}
     } else if (strcmp(subCmd, "ismaxlong") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		((longValue == LONG_MAX)? "1" : "0"), -1);
+	        ((longValue == LONG_MAX)? "1" : "0"), -1);
     } else if (strcmp(subCmd, "get") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -737,29 +609,29 @@ TestintobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	string = Tcl_GetString(varPtr[varIndex]);
 	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 {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX));
+	    SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
 	}
 	if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
 	    Tcl_ResetResult(interp);
@@ -772,149 +644,52 @@ TestintobjCmd(
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
-		&intValue) != TCL_OK) {
+			      &intValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetIntObj(varPtr[varIndex], intValue * 10);
+	    Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10));
+	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue * 10) ));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "div10") == 0) {
 	if (objc != 3) {
 	    goto wrongNumArgs;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
-		&intValue) != TCL_OK) {
+			      &intValue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (!Tcl_IsShared(varPtr[varIndex])) {
-	    Tcl_SetIntObj(varPtr[varIndex], intValue / 10);
+	    Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
 	} else {
-	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
+	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue / 10) ));
 	}
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else {
 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"bad option \"", Tcl_GetString(objv[1]),
-		"\": must be set, get, get2, mult10, or div10", NULL);
+		"\": must be set, get, get2, mult10, or div10",
+		(char *) 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 */
-    Tcl_Obj **varPtr;
-
-    if (objc < 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
-	return TCL_ERROR;
-    }
-    varPtr = GetVarPtr(interp);
-    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(varPtr, 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, varPtr,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(varPtr, 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 function implements the "testobj" command. It is used to test
+ *	This procedure implements the "testobj" command. It is used to test
  *	the type-independent portions of the Tcl object type implementation.
  *
  * Results:
@@ -927,127 +702,124 @@ TestlistobjCmd(
  */
 
 static int
-TestobjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     int varIndex, destIndex, i;
-    const char *index, *subCmd, *string;
-    const Tcl_ObjType *targetType;
-    Tcl_Obj **varPtr;
-
+    char *index, *subCmd, *string;
+    Tcl_ObjType *targetType;
+	
     if (objc < 2) {
 	wrongNumArgs:
 	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
 	return TCL_ERROR;
     }
 
-    varPtr = GetVarPtr(interp);
     subCmd = Tcl_GetString(objv[1]);
     if (strcmp(subCmd, "assign") == 0) {
-	if (objc != 4) {
-	    goto wrongNumArgs;
-	}
-	index = Tcl_GetString(objv[2]);
-	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+        if (objc != 4) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetString(objv[2]);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	string = Tcl_GetString(objv[3]);
-	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
+        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        SetVarToObj(destIndex, varPtr[varIndex]);
 	Tcl_SetObjResult(interp, varPtr[destIndex]);
-    } else if (strcmp(subCmd, "convert") == 0) {
-	const char *typeName;
-
-	if (objc != 4) {
-	    goto wrongNumArgs;
-	}
-	index = Tcl_GetString(objv[2]);
-	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+     } else if (strcmp(subCmd, "convert") == 0) {
+        char *typeName;
+        if (objc != 4) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetString(objv[2]);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	typeName = Tcl_GetString(objv[3]);
-	if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
+        typeName = Tcl_GetString(objv[3]);
+        if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
 	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		    "no type ", typeName, " found", NULL);
-	    return TCL_ERROR;
-	}
-	if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
-		!= TCL_OK) {
-	    return TCL_ERROR;
-	}
+		    "no type ", typeName, " found", (char *) NULL);
+            return TCL_ERROR;
+        }
+        if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
+            != TCL_OK) {
+            return TCL_ERROR;
+        }
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "duplicate") == 0) {
-	if (objc != 4) {
-	    goto wrongNumArgs;
-	}
-	index = Tcl_GetString(objv[2]);
-	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+        if (objc != 4) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetString(objv[2]);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
 	string = Tcl_GetString(objv[3]);
-	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	Tcl_SetObjResult(interp, varPtr[destIndex]);
     } else if (strcmp(subCmd, "freeallvars") == 0) {
-	if (objc != 2) {
-	    goto wrongNumArgs;
-	}
-	for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
-	    if (varPtr[i] != NULL) {
-		Tcl_DecrRefCount(varPtr[i]);
-		varPtr[i] = NULL;
-	    }
-	}
-    } else if (strcmp(subCmd, "invalidateStringRep") == 0) {
-	if (objc != 3) {
+        if (objc != 2) {
+            goto wrongNumArgs;
+        }
+        for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
+            if (varPtr[i] != NULL) {
+                Tcl_DecrRefCount(varPtr[i]);
+                varPtr[i] = NULL;
+            }
+        }
+    } else if ( strcmp ( subCmd, "invalidateStringRep" ) == 0 ) {
+	if ( objc != 3 ) {
 	    goto wrongNumArgs;
 	}
-	index = Tcl_GetString(objv[2]);
-	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	index = Tcl_GetString( objv[2] );
+	if ( GetVariableIndex( interp, index, &varIndex ) != TCL_OK ) {
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+        if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	Tcl_InvalidateStringRep(varPtr[varIndex]);
-	Tcl_SetObjResult(interp, varPtr[varIndex]);
+	Tcl_InvalidateStringRep( varPtr[varIndex] );
+	Tcl_SetObjResult( interp, varPtr[varIndex] );
     } else if (strcmp(subCmd, "newobj") == 0) {
-	if (objc != 3) {
-	    goto wrongNumArgs;
-	}
-	index = Tcl_GetString(objv[2]);
-	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	SetVarToObj(varPtr, varIndex, Tcl_NewObj());
+        if (objc != 3) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetString(objv[2]);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        SetVarToObj(varIndex, Tcl_NewObj());
 	Tcl_SetObjResult(interp, varPtr[varIndex]);
     } else if (strcmp(subCmd, "objtype") == 0) {
-	const char *typeName;
+	char *typeName;
 
 	/*
-	 * Return an object containing the name of the argument's type of
-	 * internal rep. If none exists, return "none".
+	 * return an object containing the name of the argument's type
+	 * of internal rep.  If none exists, return "none".
 	 */
-
-	if (objc != 3) {
-	    goto wrongNumArgs;
-	}
+	
+        if (objc != 3) {
+            goto wrongNumArgs;
+        }
 	if (objv[2]->typePtr == NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
 	} else {
@@ -1055,47 +827,52 @@ TestobjCmd(
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
 	}
     } else if (strcmp(subCmd, "refcount") == 0) {
-	if (objc != 3) {
-	    goto wrongNumArgs;
-	}
-	index = Tcl_GetString(objv[2]);
-	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+	char buf[TCL_INTEGER_SPACE];
+
+        if (objc != 3) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetString(objv[2]);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
+	TclFormatInt(buf, varPtr[varIndex]->refCount);
+        Tcl_SetResult(interp, buf, TCL_VOLATILE);
     } else if (strcmp(subCmd, "type") == 0) {
-	if (objc != 3) {
-	    goto wrongNumArgs;
-	}
-	index = Tcl_GetString(objv[2]);
-	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+        if (objc != 3) {
+            goto wrongNumArgs;
+        }
+        index = Tcl_GetString(objv[2]);
+        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
+            return TCL_ERROR;
+        }
+        if (CheckIfVarUnset(interp, varIndex)) {
 	    return TCL_ERROR;
 	}
-	if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
+        if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
 	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
-	} else {
-	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
-		    varPtr[varIndex]->typePtr->name, -1);
-	}
+        } else {
+            Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                    varPtr[varIndex]->typePtr->name, -1);
+        }
     } else if (strcmp(subCmd, "types") == 0) {
-	if (objc != 2) {
-	    goto wrongNumArgs;
-	}
+        if (objc != 2) {
+            goto wrongNumArgs;
+        }
 	if (Tcl_AppendAllObjTypes(interp,
 		Tcl_GetObjResult(interp)) != TCL_OK) {
 	    return TCL_ERROR;
 	}
     } 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", NULL);
+		"bad option \"",
+		Tcl_GetString(objv[1]),
+		"\": must be assign, convert, duplicate, freeallvars, ",
+		"newobj, objcount, objtype, refcount, type, or types",
+		(char *) NULL);
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -1106,7 +883,7 @@ TestobjCmd(
  *
  * TeststringobjCmd --
  *
- *	This function implements the "teststringobj" command. It is used to
+ *	This procedure implements the "teststringobj" command. It is used to
  *	test the string Tcl object type implementation.
  *
  * Results:
@@ -1120,22 +897,21 @@ TestobjCmd(
  */
 
 static int
-TeststringobjCmd(
-    ClientData clientData,	/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    Tcl_UniChar *unicode;
     int varIndex, option, i, length;
+    Tcl_UniChar *unicode;
 #define MAX_STRINGS 11
-    const char *index, *string, *strings[MAX_STRINGS+1];
+    char *index, *string, *strings[MAX_STRINGS+1];
     TestString *strPtr;
-    Tcl_Obj **varPtr;
-    static const char *const options[] = {
+    static CONST char *options[] = {
 	"append", "appendstrings", "get", "get2", "length", "length2",
-	"set", "set2", "setlength", "maxchars", "getunicode",
-	"appendself", "appendself2", NULL
+	"set", "set2", "setlength", "ualloc", "getunicode", 
+	"appendself", "appendself2", (char *) NULL
     };
 
     if (objc < 3) {
@@ -1144,7 +920,6 @@ TeststringobjCmd(
 	return TCL_ERROR;
     }
 
-    varPtr = GetVarPtr(interp);
     index = Tcl_GetString(objv[2]);
     if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
 	return TCL_ERROR;
@@ -1163,16 +938,16 @@ TeststringobjCmd(
 		return TCL_ERROR;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
+		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(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 	    string = Tcl_GetString(objv[3]);
 	    Tcl_AppendToObj(varPtr[varIndex], string, length);
@@ -1183,16 +958,16 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
+		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(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 	    for (i = 3;  i < objc;  i++) {
 		strings[i-3] = Tcl_GetString(objv[i]);
@@ -1210,7 +985,7 @@ TeststringobjCmd(
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
-	    if (CheckIfVarUnset(interp, varPtr,varIndex)) {
+	    if (CheckIfVarUnset(interp, varIndex)) {
 		return TCL_ERROR;
 	    }
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
@@ -1219,7 +994,7 @@ TeststringobjCmd(
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
-	    if (CheckIfVarUnset(interp, varPtr, varIndex)) {
+	    if (CheckIfVarUnset(interp, varIndex)) {
 		return TCL_ERROR;
 	    }
 	    string = Tcl_GetString(varPtr[varIndex]);
@@ -1237,9 +1012,8 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] != NULL) {
-		Tcl_ConvertToType(NULL, varPtr[varIndex],
-			Tcl_GetObjType("string"));
-		strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
+		strPtr = (TestString *)
+		    (varPtr[varIndex])->internalRep.otherValuePtr;
 		length = (int) strPtr->allocated;
 	    } else {
 		length = -1;
@@ -1253,19 +1027,19 @@ TeststringobjCmd(
 
 	    /*
 	     * 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])) {
 		Tcl_SetStringObj(varPtr[varIndex], string, length);
 	    } else {
-		SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
+		SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
 	    }
 	    Tcl_SetObjResult(interp, varPtr[varIndex]);
 	    break;
@@ -1273,7 +1047,7 @@ TeststringobjCmd(
 	    if (objc != 4) {
 		goto wrongNumArgs;
 	    }
-	    SetVarToObj(varPtr, varIndex, objv[3]);
+	    SetVarToObj(varIndex, objv[3]);
 	    break;
 	case 8:				/* setlength */
 	    if (objc != 4) {
@@ -1286,15 +1060,14 @@ TeststringobjCmd(
 		Tcl_SetObjLength(varPtr[varIndex], length);
 	    }
 	    break;
-	case 9:				/* maxchars */
+	case 9:				/* ualloc */
 	    if (objc != 3) {
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] != NULL) {
-		Tcl_ConvertToType(NULL, varPtr[varIndex],
-			Tcl_GetObjType("string"));
-		strPtr = varPtr[varIndex]->internalRep.otherValuePtr;
-		length = strPtr->maxChars;
+		strPtr = (TestString *)
+		    (varPtr[varIndex])->internalRep.otherValuePtr;
+		length = (int) strPtr->uallocated;
 	    } else {
 		length = -1;
 	    }
@@ -1311,7 +1084,7 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
+		SetVarToObj(varIndex, Tcl_NewObj());
 	    }
 
 	    /*
@@ -1320,7 +1093,7 @@ TeststringobjCmd(
 	     */
 
 	    if (Tcl_IsShared(varPtr[varIndex])) {
-		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 
 	    string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
@@ -1342,7 +1115,7 @@ TeststringobjCmd(
 		goto wrongNumArgs;
 	    }
 	    if (varPtr[varIndex] == NULL) {
-		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
+		SetVarToObj(varIndex, Tcl_NewObj());
 	    }
 
 	    /*
@@ -1351,7 +1124,7 @@ TeststringobjCmd(
 	     */
 
 	    if (Tcl_IsShared(varPtr[varIndex])) {
-		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
+		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
 	    }
 
 	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
@@ -1385,18 +1158,17 @@ TeststringobjCmd(
  *	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(
-    Tcl_Obj **varPtr,
-    int varIndex,		/* Designates the assignment variable. */
-    Tcl_Obj *objPtr)		/* Points to object to assign to var. */
+SetVarToObj(varIndex, objPtr)
+    int varIndex;		/* Designates the assignment variable. */
+    Tcl_Obj *objPtr;		/* Points to object to assign to var. */
 {
     if (varPtr[varIndex] != NULL) {
 	Tcl_DecrRefCount(varPtr[varIndex]);
@@ -1424,15 +1196,15 @@ SetVarToObj(
  */
 
 static int
-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. */
+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. */
 {
     int index;
-
+    
     if (Tcl_GetInt(interp, string, &index) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -1451,7 +1223,7 @@ GetVariableIndex(
  *
  * CheckIfVarUnset --
  *
- *	Utility function that checks whether a test variable is readable:
+ *	Utility procedure that checks whether a test variable is readable:
  *	i.e., that varPtr[varIndex] is non-NULL.
  *
  * Results:
@@ -1465,14 +1237,13 @@ GetVariableIndex(
  */
 
 static int
-CheckIfVarUnset(
-    Tcl_Interp *interp,		/* Interpreter for error reporting. */
-    Tcl_Obj ** varPtr,
-    int varIndex)		/* Index of the test variable to check. */
+CheckIfVarUnset(interp, varIndex)
+    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);
@@ -1480,11 +1251,3 @@ CheckIfVarUnset(
     }
     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 a3f89f6..c85b303 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.c
@@ -1,41 +1,39 @@
-/*
+/* 
  * 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.
  */
 
-#ifndef USE_TCL_STUBS
-#   define USE_TCL_STUBS
-#endif
 #include "tclInt.h"
 
 /*
  * 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
  * procs
  */
 
-typedef struct CmdTable {
-    const char *cmdName;		/* command name */
+typedef struct CmdTable
+{
+    CONST char *cmdName;	/* command name */
     Tcl_ObjCmdProc *proc;	/* command proc */
     int exportIt;		/* if 1, export the command */
 } CmdTable;
@@ -44,24 +42,31 @@ typedef struct CmdTable {
  * Declarations for functions defined in this file.
  */
 
-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);
+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));
 
 /*
  * 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 }
 };
 
@@ -70,21 +75,21 @@ static const CmdTable safeCommands[] = {
  *
  * Procbodytest_Init --
  *
- *	This function initializes the "procbodytest" package.
+ *  This procedure initializes the "procbodytest" package.
  *
  * Results:
- *	A standard Tcl result.
+ *  A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *  None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Procbodytest_Init(
-    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
-				 * is initialized */
+Procbodytest_Init(interp)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 0);
 }
@@ -94,21 +99,21 @@ Procbodytest_Init(
  *
  * Procbodytest_SafeInit --
  *
- *	This function initializes the "procbodytest" package.
+ *  This procedure initializes the "procbodytest" package.
  *
  * Results:
- *	A standard Tcl result.
+ *  A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *  None.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Procbodytest_SafeInit(
-    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
-				 * is initialized */
+Procbodytest_SafeInit(interp)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
 {
     return ProcBodyTestInitInternal(interp, 1);
 }
@@ -118,38 +123,36 @@ Procbodytest_SafeInit(
  *
  * RegisterCommand --
  *
- *	This function registers a command in the context of the given
- *	namespace.
+ *  This procedure registers a command in the context of the given namespace.
  *
  * Results:
- *	A standard Tcl result.
+ *  A standard Tcl result.
  *
  * Side effects:
- *	None.
+ *  None.
  *
  *----------------------------------------------------------------------
  */
 
-static int
-RegisterCommand(
-    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 */
+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 */
 {
     char buf[128];
 
     if (cmdTablePtr->exportIt) {
-	sprintf(buf, "namespace eval %s { namespace export %s }",
-		namespace, cmdTablePtr->cmdName);
-	if (Tcl_Eval(interp, buf) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+        sprintf(buf, "namespace eval %s { namespace export %s }",
+                namespace, cmdTablePtr->cmdName);
+        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);
+
     return TCL_OK;
 }
 
@@ -158,7 +161,7 @@ RegisterCommand(
  *
  * ProcBodyTestInitInternal --
  *
- *  This function initializes the Loader package.
+ *  This procedure initializes the Loader package.
  *  The isSafe flag is 1 if the interpreter is safe, 0 otherwise.
  *
  * Results:
@@ -171,20 +174,20 @@ RegisterCommand(
  */
 
 static int
-ProcBodyTestInitInternal(
-    Tcl_Interp *interp,		/* the Tcl interpreter for which the package
-				 * is initialized */
-    int isSafe)			/* 1 if this is a safe interpreter */
+ProcBodyTestInitInternal(interp, isSafe)
+    Tcl_Interp *interp;		/* the Tcl interpreter for which the package
+                                 * is initialized */
+    int isSafe;			/* 1 if this is a safe interpreter */
 {
-    const CmdTable *cmdTablePtr;
+    CONST CmdTable *cmdTablePtr;
 
     cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
     for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
-	if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+        if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
+            return TCL_ERROR;
+        }
     }
-
+    
     return Tcl_PkgProvide(interp, packageName, packageVersion);
 }
 
@@ -222,20 +225,20 @@ ProcBodyTestInitInternal(
  */
 
 static int
-ProcBodyTestProcObjCmd(
-    ClientData dummy,		/* context; not used */
-    Tcl_Interp *interp,		/* the current interpreter */
-    int objc,			/* argument count */
-    Tcl_Obj *const objv[])	/* arguments */
+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 */
 {
-    const char *fullName;
+    char *fullName;
     Tcl_Command procCmd;
     Command *cmdPtr;
-    Proc *procPtr = NULL;
+    Proc *procPtr = (Proc *) NULL;
     Tcl_Obj *bodyObjPtr;
     Tcl_Obj *myobjv[5];
     int result;
-
+    
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
 	return TCL_ERROR;
@@ -244,47 +247,60 @@ ProcBodyTestProcObjCmd(
     /*
      * Find the Command pointer to this procedure
      */
-
-    fullName = Tcl_GetStringFromObj(objv[3], NULL);
-    procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
+    
+    fullName = Tcl_GetStringFromObj(objv[3], (int *) NULL);
+    procCmd = Tcl_FindCommand(interp, fullName, (Tcl_Namespace *) NULL,
+            TCL_LEAVE_ERR_MSG);
     if (procCmd == NULL) {
-	return TCL_ERROR;
+        return TCL_ERROR;
     }
 
     cmdPtr = (Command *) procCmd;
 
     /*
      * check that this is a procedure and not a builtin command:
-     * If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr).
+     * 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 (cmdPtr->objClientData != TclIsProc(cmdPtr)) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-		"command \"", fullName, "\" is not a Tcl procedure", NULL);
-	return TCL_ERROR;
+    if (((cmdPtr->objProc != NULL)
+            && (cmdPtr->objProc != TclGetObjInterpProc()))
+            || ((cmdPtr->proc != NULL)
+                    && (cmdPtr->proc != TclGetInterpProc()))) {
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"command \"", fullName,
+		"\" is not a Tcl procedure", (char *) 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!", NULL);
-	return TCL_ERROR;
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+		"procedure \"", fullName,
+		"\" does not have a Proc struct!", (char *) NULL);
+        return TCL_ERROR;
     }
-
+        
     /*
      * create a new object, initialize our argument vector, call into Tcl
      */
 
     bodyObjPtr = TclNewProcBodyObj(procPtr);
     if (bodyObjPtr == NULL) {
-	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
 		"failed to create a procbody object for procedure \"",
-		fullName, "\"", NULL);
-	return TCL_ERROR;
+                fullName, "\"", (char *) NULL);
+        return TCL_ERROR;
     }
     Tcl_IncrRefCount(bodyObjPtr);
 
@@ -292,18 +308,10 @@ ProcBodyTestProcObjCmd(
     myobjv[1] = objv[1];
     myobjv[2] = objv[2];
     myobjv[3] = bodyObjPtr;
-    myobjv[4] = NULL;
+    myobjv[4] = (Tcl_Obj *) NULL;
 
-    result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
+    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 d1f2691..c2f769d 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -1,22 +1,22 @@
-/*
+/* 
  * 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.
- * Copyright (c) 2008 by George Peter Staplin
  *
- * 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
@@ -25,7 +25,7 @@
 typedef struct {
     int num;		/* Number of objects remembered */
     int max;		/* Max size of the array */
-    void **list;	/* List of pointers */
+    char **list;	/* List of pointers */
 } SyncObjRecord;
 
 static SyncObjRecord keyRecord = {0, 0, NULL};
@@ -33,19 +33,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(void *objPtr, SyncObjRecord *recPtr);
-static void		RememberSyncObject(void *objPtr,
-			    SyncObjRecord *recPtr);
-
-/*
+/* 
  * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
- * specified. Here we undo that so the functions are defined in the stubs
- * table.
+ * specified.  Here we undo that so the procedures are defined in the
+ * stubs table.
  */
-
 #ifndef TCL_THREADS
 #undef Tcl_MutexLock
 #undef Tcl_MutexUnlock
@@ -54,53 +54,61 @@ static void		RememberSyncObject(void *objPtr,
 #undef Tcl_ConditionWait
 #undef Tcl_ConditionFinalize
 #endif
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_GetThreadData --
  *
- *	This function allocates and initializes a chunk of thread local
- *	storage.
+ *	This procedure 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(
-    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
-    int size)			/* Size of storage block */
+VOID *
+Tcl_GetThreadData(keyPtr, size)
+    Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk */
+    int size;			/* Size of storage block */
 {
-    void *result;
+    VOID *result;
 #ifdef TCL_THREADS
+
     /*
-     * Initialize the key for this thread.
+     * See if this is the first thread to init this key.
      */
 
-    result = TclThreadStorageKeyGet(keyPtr);
+    if (*keyPtr == NULL) {
+	TclpThreadDataKeyInit(keyPtr);
+    }
 
+    /*
+     * Initialize the key for this thread.
+     */
+
+    result = TclpThreadDataKeyGet(keyPtr);
     if (result == NULL) {
-	result = ckalloc(size);
-	memset(result, 0, (size_t) size);
-	TclThreadStorageKeySet(keyPtr, result);
+	result  = (VOID *)ckalloc((size_t)size);
+	memset(result, 0, (size_t)size);
+	TclpThreadDataKeySet(keyPtr, result);
     }
-#else /* TCL_THREADS */
+#else
     if (*keyPtr == NULL) {
-	result = ckalloc(size);
-	memset(result, 0, (size_t)size);
-	*keyPtr = result;
-	RememberSyncObject(keyPtr, &keyRecord);
-    } else {
-	result = *keyPtr;
+	result = (VOID *)ckalloc((size_t)size);
+	memset((char *)result, 0, (size_t)size);
+	*keyPtr = (Tcl_ThreadDataKey)result;
+	TclRememberDataKey(keyPtr);
     }
-#endif /* TCL_THREADS */
+    result = *(VOID **)keyPtr;
+#endif
     return result;
 }
 
@@ -109,11 +117,11 @@ Tcl_GetThreadData(
  *
  * TclThreadDataKeyGet --
  *
- *	This function returns a pointer to a block of thread local storage.
+ *	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.
+ *	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.
@@ -121,25 +129,61 @@ Tcl_GetThreadData(
  *----------------------------------------------------------------------
  */
 
-void *
-TclThreadDataKeyGet(
-    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk. */
+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 */
 {
 #ifdef TCL_THREADS
-    return TclThreadStorageKeyGet(keyPtr);
-#else /* TCL_THREADS */
-    return *keyPtr;
+    if (*keyPtr == NULL) {
+	TclpThreadDataKeyInit(keyPtr);
+    }
+    TclpThreadDataKeySet(keyPtr, data);
+#else
+    *keyPtr = (Tcl_ThreadDataKey)data;
 #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.
  *
@@ -153,23 +197,22 @@ TclThreadDataKeyGet(
  */
 
 static void
-RememberSyncObject(
-    void *objPtr,		/* Pointer to sync object */
-    SyncObjRecord *recPtr)	/* Record of sync objects */
+RememberSyncObject(objPtr, recPtr)
+    char *objPtr;		/* Pointer to sync object */
+    SyncObjRecord *recPtr;	/* Record of sync objects */
 {
-    void **newList;
+    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;
-	}
+	} 
     }
 
     /*
@@ -179,14 +222,14 @@ RememberSyncObject(
 
     if (recPtr->num >= recPtr->max) {
 	recPtr->max += 8;
-	newList = ckalloc(recPtr->max * sizeof(void *));
-	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(recPtr->list);
+	    ckfree((char *)recPtr->list);
 	}
 	recPtr->list = newList;
 	recPtr->num = j;
@@ -201,7 +244,7 @@ RememberSyncObject(
  *
  * ForgetSyncObject
  *
- *	Remove a single object from the list.
+ *      Remove a single object from the list.
  *	Assume master lock is held.
  *
  * Results:
@@ -214,9 +257,9 @@ RememberSyncObject(
  */
 
 static void
-ForgetSyncObject(
-    void *objPtr,		/* Pointer to sync object */
-    SyncObjRecord *recPtr)	/* Record of sync objects */
+ForgetSyncObject(objPtr, recPtr)
+    char *objPtr;		/* Pointer to sync object */
+    SyncObjRecord *recPtr;	/* Record of sync objects */
 {
     int i;
 
@@ -233,7 +276,7 @@ ForgetSyncObject(
  *
  * TclRememberMutex
  *
- *	Keep a list of mutexes used during finalization.
+ *      Keep a list of mutexes used during finalization.
  *	Assume master lock is held.
  *
  * Results:
@@ -246,19 +289,19 @@ ForgetSyncObject(
  */
 
 void
-TclRememberMutex(
-    Tcl_Mutex *mutexPtr)
+TclRememberMutex(mutexPtr)
+    Tcl_Mutex *mutexPtr;
 {
-    RememberSyncObject(mutexPtr, &mutexRecord);
+    RememberSyncObject((char *)mutexPtr, &mutexRecord);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * 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.
@@ -270,23 +313,47 @@ TclRememberMutex(
  */
 
 void
-Tcl_MutexFinalize(
-    Tcl_Mutex *mutexPtr)
+Tcl_MutexFinalize(mutexPtr)
+    Tcl_Mutex *mutexPtr;
 {
 #ifdef TCL_THREADS
     TclpFinalizeMutex(mutexPtr);
 #endif
     TclpMasterLock();
-    ForgetSyncObject(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:
@@ -299,19 +366,19 @@ Tcl_MutexFinalize(
  */
 
 void
-TclRememberCondition(
-    Tcl_Condition *condPtr)
+TclRememberCondition(condPtr)
+    Tcl_Condition *condPtr;
 {
-    RememberSyncObject(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.
@@ -323,14 +390,14 @@ TclRememberCondition(
  */
 
 void
-Tcl_ConditionFinalize(
-    Tcl_Condition *condPtr)
+Tcl_ConditionFinalize(condPtr)
+    Tcl_Condition *condPtr;
 {
 #ifdef TCL_THREADS
     TclpFinalizeCondition(condPtr);
 #endif
     TclpMasterLock();
-    ForgetSyncObject(condPtr, &condRecord);
+    ForgetSyncObject((char *)condPtr, &condRecord);
     TclpMasterUnlock();
 }
 
@@ -339,8 +406,8 @@ Tcl_ConditionFinalize(
  *
  * TclFinalizeThreadData --
  *
- *	This function cleans up the thread-local storage. This is called once
- *	for each thread.
+ *	This procedure cleans up the thread-local storage.  This is
+ *	called once for each thread.
  *
  * Results:
  *	None.
@@ -352,9 +419,24 @@ Tcl_ConditionFinalize(
  */
 
 void
-TclFinalizeThreadData(void)
+TclFinalizeThreadData()
 {
-    TclFinalizeThreadDataThread();
+    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();
 }
 
 /*
@@ -362,8 +444,8 @@ TclFinalizeThreadData(void)
  *
  * TclFinalizeSynchronization --
  *
- *	This function cleans up all synchronization objects: mutexes,
- *	condition variables, and thread-local storage.
+ *      This procedure cleans up all synchronization objects:
+ *      mutexes, condition variables, and thread-local storage.
  *
  * Results:
  *	None.
@@ -375,42 +457,26 @@ TclFinalizeThreadData(void)
  */
 
 void
-TclFinalizeSynchronization(void)
+TclFinalizeSynchronization()
 {
-    int i;
-    void *blockPtr;
-    Tcl_ThreadDataKey *keyPtr;
 #ifdef TCL_THREADS
+    Tcl_ThreadDataKey *keyPtr;
     Tcl_Mutex *mutexPtr;
     Tcl_Condition *condPtr;
+    int i;
 
     TclpMasterLock();
-#endif
-
-    /*
-     * If we're running unthreaded, the TSD blocks are simply stored inside
-     * their thread data keys. Free them here.
-     */
-
+    for (i=0 ; i<keyRecord.num ; i++) {
+	keyPtr = (Tcl_ThreadDataKey *)keyRecord.list[i];
+	TclpFinalizeThreadDataKey(keyPtr);
+    }
     if (keyRecord.list != NULL) {
-	for (i=0 ; i<keyRecord.num ; i++) {
-	    keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
-	    blockPtr = *keyPtr;
-	    ckfree(blockPtr);
-	}
-	ckfree(keyRecord.list);
+	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];
 	if (mutexPtr != NULL) {
@@ -418,37 +484,45 @@ TclFinalizeSynchronization(void)
 	}
     }
     if (mutexRecord.list != NULL) {
-	ckfree(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(condRecord.list);
+	ckfree((char *)condRecord.list);
 	condRecord.list = NULL;
     }
     condRecord.max = 0;
     condRecord.num = 0;
 
     TclpMasterUnlock();
-#endif /* TCL_THREADS */
+#else
+    if (keyRecord.list != NULL) {
+	ckfree((char *)keyRecord.list);
+	keyRecord.list = NULL;
+    }
+    keyRecord.max = 0;
+    keyRecord.num = 0;
+#endif
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_ExitThread --
  *
- *	This function is called to terminate the current thread. This should
- *	be used by extensions that create threads with additional interpreters
- *	in them.
+ *	This procedure is called to terminate the current thread.
+ *	This should be used by extensions that create threads with
+ *	additional interpreters in them.
  *
  * Results:
  *	None.
@@ -460,8 +534,8 @@ TclFinalizeSynchronization(void)
  */
 
 void
-Tcl_ExitThread(
-    int status)
+Tcl_ExitThread(status)
+    int status;
 {
     Tcl_FinalizeThread();
 #ifdef TCL_THREADS
@@ -476,9 +550,10 @@ Tcl_ExitThread(
  *
  * Tcl_ConditionWait, et al. --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -491,39 +566,31 @@ Tcl_ExitThread(
 
 #undef Tcl_ConditionWait
 void
-Tcl_ConditionWait(
-    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
-    Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
-    const Tcl_Time *timePtr) /* Timeout on waiting period */
+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 */
 {
 }
 
 #undef Tcl_ConditionNotify
 void
-Tcl_ConditionNotify(
-    Tcl_Condition *condPtr)
+Tcl_ConditionNotify(condPtr)
+    Tcl_Condition *condPtr;
 {
 }
 
 #undef Tcl_MutexLock
 void
-Tcl_MutexLock(
-    Tcl_Mutex *mutexPtr)
+Tcl_MutexLock(mutexPtr)
+    Tcl_Mutex *mutexPtr;
 {
 }
 
 #undef Tcl_MutexUnlock
 void
-Tcl_MutexUnlock(
-    Tcl_Mutex *mutexPtr)
+Tcl_MutexUnlock(mutexPtr)
+    Tcl_Mutex *mutexPtr;
 {
 }
-#endif /* !TCL_THREADS */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
+#endif
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index e4261d6..ad9f0a0 100644..100755
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -2,22 +2,31 @@
  * 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)
+
+#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 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
@@ -29,23 +38,33 @@
 #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 NOBJHIGH	1200
 
-#define NOBJALLOC	800
+/*
+ * Alignment for allocated memory.
+ */
 
-/* Actual definition moved to tclInt.h */
-#define NOBJHIGH	ALLOC_NOBJHIGH
+#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.
+ * 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 {
@@ -59,117 +78,93 @@ typedef union Block {
 	} u;
 	size_t reqSize;			/* Requested allocation size. */
     } b;
-    unsigned char padding[TCL_ALLOCALIGN];
+    unsigned char padding[ALLOCALIGN];
 } Block;
-#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
+#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
 
 /*
  * The following defines the minimum and and maximum block sizes and the number
  * of buckets in the bucket cache.
  */
 
-#define MINALLOC	((sizeof(Block) + 8 + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
+#define MINALLOC	((sizeof(Block) + 8 + (ALLOCALIGN-1)) & ~(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;		/* 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 */
+    Block *firstPtr;
+    long nfree;
+    long nget;
+    long nput;
+    long nwait;
+    long nlock;
+    long nrequest;
 } Bucket;
 
 /*
- * The following structure defines a cache of buckets and objs, of which there
- * will be (at most) one per thread. Any changes need to be reflected in the
- * struct AllocCache defined in tclInt.h, possibly also in the initialisation
- * code in Tcl_CreateInterp().
+ * The following structure defines a cache of buckets and objs.
  */
 
 typedef struct Cache {
-    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 */
+    struct Cache  *nextPtr;
+    Tcl_ThreadId   owner;
+    Tcl_Obj       *firstObjPtr;
+    int            nobjs;
+    int	           nsysalloc;
+    Bucket         buckets[NBUCKETS];
 } 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.
  */
 
-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];
+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 functions defined in this file.
  */
 
-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);
+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);
 
 /*
- * 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;
-
-#if defined(HAVE_FAST_TSD)
-static __thread Cache *tcachePtr;
-
-# define GETCACHE(cachePtr)			\
-    do {					\
-	if (!tcachePtr) {			\
-	    tcachePtr = GetCache();		\
-	}					\
-	(cachePtr) = tcachePtr;			\
-    } while (0)
-#else
-# define GETCACHE(cachePtr)			\
-    do {					\
-	(cachePtr) = TclpGetAllocCache();	\
-	if ((cachePtr) == NULL) {		\
-	    (cachePtr) = GetCache();		\
-	}					\
-    } while (0)
-#endif
+static Cache     sharedCache;
+static Cache    *sharedPtr = &sharedCache;
+static Cache    *firstCachePtr = &sharedCache;
+
 
 /*
  *----------------------------------------------------------------------
  *
- * GetCache ---
+ *  GetCache ---
  *
  *	Gets per-thread memory cache, allocating it if necessary.
  *
@@ -177,7 +172,7 @@ static __thread Cache *tcachePtr;
  *	Pointer to cache.
  *
  * Side effects:
- *	None.
+ *  	None.
  *
  *----------------------------------------------------------------------
  */
@@ -201,11 +196,10 @@ GetCache(void)
 	    listLockPtr = TclpNewAllocMutex();
 	    objLockPtr = TclpNewAllocMutex();
 	    for (i = 0; i < NBUCKETS; ++i) {
-		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();
+		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();
 	    }
 	}
 	Tcl_MutexUnlock(initLockPtr);
@@ -217,24 +211,25 @@ GetCache(void)
 
     cachePtr = TclpGetAllocCache();
     if (cachePtr == NULL) {
-	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();
+    	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();
 	TclpSetAllocCache(cachePtr);
     }
     return cachePtr;
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * TclFreeAllocCache --
+ *  TclFreeAllocCache --
  *
  *	Flush and delete a cache, removing from list of caches.
  *
@@ -248,8 +243,7 @@ GetCache(void)
  */
 
 void
-TclFreeAllocCache(
-    void *arg)
+TclFreeAllocCache(void *arg)
 {
     Cache *cachePtr = arg;
     Cache **nextPtrPtr;
@@ -260,8 +254,8 @@ TclFreeAllocCache(
      */
 
     for (bucket = 0; bucket < NBUCKETS; ++bucket) {
-	if (cachePtr->buckets[bucket].numFree > 0) {
-	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree);
+	if (cachePtr->buckets[bucket].nfree > 0) {
+	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].nfree);
 	}
     }
 
@@ -269,10 +263,10 @@ TclFreeAllocCache(
      * Flush objs.
      */
 
-    if (cachePtr->numObjects > 0) {
-	Tcl_MutexLock(objLockPtr);
-	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
-	Tcl_MutexUnlock(objLockPtr);
+    if (cachePtr->nobjs > 0) {
+    	Tcl_MutexLock(objLockPtr);
+    	MoveObjs(cachePtr, sharedPtr, cachePtr->nobjs);
+    	Tcl_MutexUnlock(objLockPtr);
     }
 
     /*
@@ -289,11 +283,12 @@ TclFreeAllocCache(
     Tcl_MutexUnlock(listLockPtr);
     free(cachePtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpAlloc --
+ *  TclpAlloc --
  *
  *	Allocate memory.
  *
@@ -307,70 +302,72 @@ TclFreeAllocCache(
  */
 
 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
-
-    GETCACHE(cachePtr);
 
+    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++;
+    ++size;
 #endif
     if (size > MAXALLOC) {
 	bucket = NBUCKETS;
-	blockPtr = malloc(size);
+    	blockPtr = malloc(size);
 	if (blockPtr != NULL) {
-	    cachePtr->totalAssigned += reqSize;
+	    cachePtr->nsysalloc += reqsize;
 	}
     } else {
-	bucket = 0;
-	while (bucketInfo[bucket].blockSize < size) {
-	    bucket++;
-	}
-	if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) {
+    	bucket = 0;
+    	while (binfo[bucket].blocksize < size) {
+    	    ++bucket;
+    	}
+    	if (cachePtr->buckets[bucket].nfree || GetBlocks(cachePtr, bucket)) {
 	    blockPtr = cachePtr->buckets[bucket].firstPtr;
-	    cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
-	    cachePtr->buckets[bucket].numFree--;
-	    cachePtr->buckets[bucket].numRemoves++;
-	    cachePtr->buckets[bucket].totalAssigned += reqSize;
+	    cachePtr->buckets[bucket].firstPtr = blockPtr->b_next;
+	    --cachePtr->buckets[bucket].nfree;
+    	    ++cachePtr->buckets[bucket].nget;
+	    cachePtr->buckets[bucket].nrequest += 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.
  *
@@ -384,49 +381,49 @@ TclpAlloc(
  */
 
 void
-TclpFree(
-    char *ptr)
+TclpFree(char *ptr)
 {
-    Cache *cachePtr;
-    Block *blockPtr;
-    int bucket;
+    if (ptr != NULL) {
+	Cache  *cachePtr = TclpGetAllocCache();
+	Block *blockPtr;
+	int bucket;
 
-    if (ptr == NULL) {
-	return;
-    }
-
-    GETCACHE(cachePtr);
-
-    /*
-     * 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 == 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 (cachePtr != sharedPtr &&
-	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
-	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
+	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);
+	    }
+	}
     }
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpRealloc --
+ *  TclpRealloc --
  *
  *	Re-allocate memory to a larger or smaller size.
  *
@@ -440,82 +437,83 @@ TclpFree(
  */
 
 char *
-TclpRealloc(
-    char *ptr,
-    unsigned int reqSize)
+TclpRealloc(char *ptr, unsigned int reqsize)
 {
     Cache *cachePtr;
     Block *blockPtr;
-    void *newPtr;
+    void *new;
     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
 
-    GETCACHE(cachePtr);
+    cachePtr = TclpGetAllocCache();
+    if (cachePtr == NULL) {
+	cachePtr = GetCache();
+    }
 
     /*
-     * 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++;
+    ++size;
 #endif
-    bucket = blockPtr->sourceBucket;
+    bucket = blockPtr->b_bucket;
     if (bucket != NBUCKETS) {
 	if (bucket > 0) {
-	    min = bucketInfo[bucket-1].blockSize;
+	    min = binfo[bucket-1].blocksize;
 	} else {
 	    min = 0;
 	}
-	if (size > min && size <= bucketInfo[bucket].blockSize) {
-	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
-	    cachePtr->buckets[bucket].totalAssigned += reqSize;
-	    return Block2Ptr(blockPtr, bucket, reqSize);
+	if (size > min && size <= binfo[bucket].blocksize) {
+	    cachePtr->buckets[bucket].nrequest -= blockPtr->b_reqsize;
+	    cachePtr->buckets[bucket].nrequest += reqsize;
+	    return Block2Ptr(blockPtr, bucket, reqsize);
 	}
     } else if (size > MAXALLOC) {
-	cachePtr->totalAssigned -= blockPtr->blockReqSize;
-	cachePtr->totalAssigned += reqSize;
+	cachePtr->nsysalloc -= blockPtr->b_reqsize;
+	cachePtr->nsysalloc += 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.
      */
 
-    newPtr = TclpAlloc(reqSize);
-    if (newPtr != NULL) {
-	if (reqSize > blockPtr->blockReqSize) {
-	    reqSize = blockPtr->blockReqSize;
+    new = TclpAlloc(reqsize);
+    if (new != NULL) {
+	if (reqsize > blockPtr->b_reqsize) {
+	    reqsize = blockPtr->b_reqsize;
 	}
-	memcpy(newPtr, ptr, reqSize);
-	TclpFree(ptr);
+    	memcpy(new, ptr, reqsize);
+    	TclpFree(ptr);
     }
-    return newPtr;
+    return new;
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -528,12 +526,8 @@ TclpRealloc(
  *	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.
- *
- * Note:
- *	If this code is updated, the changes need to be reflected in the macro
- *	TclAllocObjStorageEx() defined in tclInt.h
+ *	May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's
+ *  	if list is empty.
  *
  *----------------------------------------------------------------------
  */
@@ -541,38 +535,38 @@ TclpRealloc(
 Tcl_Obj *
 TclThreadAllocObj(void)
 {
-    register Cache *cachePtr;
+    register Cache *cachePtr = TclpGetAllocCache();
+    register int nmove;
     register Tcl_Obj *objPtr;
+    Tcl_Obj *newObjsPtr;
 
-    GETCACHE(cachePtr);
+    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->numObjects == 0) {
-	register int numMove;
-
-	Tcl_MutexLock(objLockPtr);
-	numMove = sharedPtr->numObjects;
-	if (numMove > 0) {
-	    if (numMove > NOBJALLOC) {
-		numMove = NOBJALLOC;
+     
+    if (cachePtr->nobjs == 0) {
+    	Tcl_MutexLock(objLockPtr);
+	nmove = sharedPtr->nobjs;
+	if (nmove > 0) {
+	    if (nmove > NOBJALLOC) {
+		nmove = NOBJALLOC;
 	    }
-	    MoveObjs(sharedPtr, cachePtr, numMove);
+	    MoveObjs(sharedPtr, cachePtr, nmove);
 	}
-	Tcl_MutexUnlock(objLockPtr);
-	if (cachePtr->numObjects == 0) {
-	    Tcl_Obj *newObjsPtr;
-
-	    cachePtr->numObjects = numMove = NOBJALLOC;
-	    newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
+    	Tcl_MutexUnlock(objLockPtr);
+	if (cachePtr->nobjs == 0) {
+	    cachePtr->nobjs = nmove = NOBJALLOC;
+	    newObjsPtr = malloc(sizeof(Tcl_Obj) * nmove);
 	    if (newObjsPtr == NULL) {
-		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
+		panic("alloc: could not allocate %d new objects", nmove);
 	    }
-	    while (--numMove >= 0) {
-		objPtr = &newObjsPtr[numMove];
+	    while (--nmove >= 0) {
+		objPtr = &newObjsPtr[nmove];
 		objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
 		cachePtr->firstObjPtr = objPtr;
 	    }
@@ -585,9 +579,10 @@ TclThreadAllocObj(void)
 
     objPtr = cachePtr->firstObjPtr;
     cachePtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
-    cachePtr->numObjects--;
+    --cachePtr->nobjs;
     return objPtr;
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -600,42 +595,41 @@ TclThreadAllocObj(void)
  *	None.
  *
  * Side effects:
- *	May move free Tcl_Obj's to shared list upon hitting high water mark.
- *
- * Note:
- *	If this code is updated, the changes need to be reflected in the macro
- *	TclAllocObjStorageEx() defined in tclInt.h
+ *	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;
+    Cache *cachePtr = TclpGetAllocCache();
 
-    GETCACHE(cachePtr);
+    if (cachePtr == NULL) {
+	cachePtr = GetCache();
+    }
 
     /*
      * Get this thread's list and push on the free Tcl_Obj.
      */
-
+     
     objPtr->internalRep.otherValuePtr = cachePtr->firstObjPtr;
     cachePtr->firstObjPtr = objPtr;
-    cachePtr->numObjects++;
-
+    ++cachePtr->nobjs;
+    
     /*
-     * 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->numObjects > NOBJHIGH) {
+     
+    if (cachePtr->nobjs > NOBJHIGH) {
 	Tcl_MutexLock(objLockPtr);
 	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
 	Tcl_MutexUnlock(objLockPtr);
     }
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -648,14 +642,13 @@ TclThreadFreeObj(
  *	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];
@@ -666,27 +659,28 @@ Tcl_GetMemoryInfo(
     while (cachePtr != NULL) {
 	Tcl_DStringStartSublist(dsPtr);
 	if (cachePtr == sharedPtr) {
-	    Tcl_DStringAppendElement(dsPtr, "shared");
+    	    Tcl_DStringAppendElement(dsPtr, "shared");
 	} else {
-	    sprintf(buf, "thread%p", cachePtr->owner);
-	    Tcl_DStringAppendElement(dsPtr, buf);
+	    sprintf(buf, "thread%d", (int) cachePtr->owner);
+    	    Tcl_DStringAppendElement(dsPtr, buf);
 	}
 	for (n = 0; n < NBUCKETS; ++n) {
-	    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);
+    	    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);
 	    Tcl_DStringAppendElement(dsPtr, buf);
 	}
 	Tcl_DStringEndSublist(dsPtr);
-	cachePtr = cachePtr->nextPtr;
+	    cachePtr = cachePtr->nextPtr;
     }
     Tcl_MutexUnlock(listLockPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -699,46 +693,45 @@ Tcl_GetMemoryInfo(
  *	None.
  *
  * Side effects:
- *	None.
+ *  	None.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-MoveObjs(
-    Cache *fromPtr,
-    Cache *toPtr,
-    int numMove)
+MoveObjs(Cache *fromPtr, Cache *toPtr, int nmove)
 {
     register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
     Tcl_Obj *fromFirstObjPtr = objPtr;
 
-    toPtr->numObjects += numMove;
-    fromPtr->numObjects -= numMove;
+    toPtr->nobjs += nmove;
+    fromPtr->nobjs -= nmove;
 
     /*
-     * 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 (--numMove) {
+    while (--nmove) {
 	objPtr = objPtr->internalRep.otherValuePtr;
     }
-    fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;
+    fromPtr->firstObjPtr = objPtr->internalRep.otherValuePtr;    
 
     /*
-     * 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;
     toPtr->firstObjPtr = fromFirstObjPtr;
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * Block2Ptr, Ptr2Block --
+ *  Block2Ptr, Ptr2Block --
  *
  *	Convert between internal blocks and user pointers.
  *
@@ -752,83 +745,84 @@ MoveObjs(
  */
 
 static char *
-Block2Ptr(
-    Block *blockPtr,
-    int bucket,
-    unsigned int reqSize)
+Block2Ptr(Block *blockPtr, int bucket, unsigned int reqsize) 
 {
     register void *ptr;
 
-    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
-    blockPtr->sourceBucket = bucket;
-    blockPtr->blockReqSize = reqSize;
+    blockPtr->b_magic1 = blockPtr->b_magic2 = MAGIC;
+    blockPtr->b_bucket = bucket;
+    blockPtr->b_reqsize = 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->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
-	Tcl_Panic("alloc: invalid block: %p: %x %x",
-		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
-    }
+    if (blockPtr->b_magic1 != MAGIC
 #if RCHECK
-    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]);
-    }
+	|| ((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]);
+    }
     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)
 {
-    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
-    cachePtr->buckets[bucket].numLocks++;
-    sharedPtr->buckets[bucket].numLocks++;
+#if 0
+    if (Tcl_MutexTryLock(binfo[bucket].lockPtr) != TCL_OK) {
+	Tcl_MutexLock(binfo[bucket].lockPtr);
+    	++cachePtr->buckets[bucket].nwait;
+    	++sharedPtr->buckets[bucket].nwait;
+    }
+#else
+    Tcl_MutexLock(binfo[bucket].lockPtr);
+#endif
+    ++cachePtr->buckets[bucket].nlock;
+    ++sharedPtr->buckets[bucket].nlock;
 }
 
+
 static void
-UnlockBucket(
-    Cache *cachePtr,
-    int bucket)
+UnlockBucket(Cache *cachePtr, int bucket)
 {
-    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
+    Tcl_MutexUnlock(binfo[bucket].lockPtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * PutBlocks --
+ *  PutBlocks --
  *
  *	Return unused blocks to the shared cache.
  *
@@ -842,42 +836,40 @@ UnlockBucket(
  */
 
 static void
-PutBlocks(
-    Cache *cachePtr,
-    int bucket,
-    int numMove)
+PutBlocks(Cache *cachePtr, int bucket, int nmove)
 {
     register Block *lastPtr, *firstPtr;
-    register int n = numMove;
+    register int n = nmove;
 
     /*
-     * 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->nextBlock;
+	lastPtr = lastPtr->b_next;
     }
-    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
-    cachePtr->buckets[bucket].numFree -= numMove;
+    cachePtr->buckets[bucket].firstPtr = lastPtr->b_next;
+    cachePtr->buckets[bucket].nfree -= nmove;
 
     /*
-     * 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->nextBlock = sharedPtr->buckets[bucket].firstPtr;
+    lastPtr->b_next = sharedPtr->buckets[bucket].firstPtr;
     sharedPtr->buckets[bucket].firstPtr = firstPtr;
-    sharedPtr->buckets[bucket].numFree += numMove;
+    sharedPtr->buckets[bucket].nfree += nmove;
     UnlockBucket(cachePtr, bucket);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * GetBlocks --
+ *  GetBlocks --
  *
  *	Get more blocks for a bucket.
  *
@@ -891,69 +883,67 @@ PutBlocks(
  */
 
 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 numFree 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 nfree 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].numFree > 0) {
+     
+    if (cachePtr != sharedPtr && sharedPtr->buckets[bucket].nfree > 0) {
 	LockBucket(cachePtr, bucket);
-	if (sharedPtr->buckets[bucket].numFree > 0) {
+	if (sharedPtr->buckets[bucket].nfree > 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 = bucketInfo[bucket].numMove;
-	    if (n >= sharedPtr->buckets[bucket].numFree) {
+	    n = binfo[bucket].nmove;
+	    if (n >= sharedPtr->buckets[bucket].nfree) {
 		cachePtr->buckets[bucket].firstPtr =
-			sharedPtr->buckets[bucket].firstPtr;
-		cachePtr->buckets[bucket].numFree =
-			sharedPtr->buckets[bucket].numFree;
+		    sharedPtr->buckets[bucket].firstPtr;
+		cachePtr->buckets[bucket].nfree =
+		    sharedPtr->buckets[bucket].nfree;
 		sharedPtr->buckets[bucket].firstPtr = NULL;
-		sharedPtr->buckets[bucket].numFree = 0;
+		sharedPtr->buckets[bucket].nfree = 0;
 	    } else {
 		blockPtr = sharedPtr->buckets[bucket].firstPtr;
 		cachePtr->buckets[bucket].firstPtr = blockPtr;
-		sharedPtr->buckets[bucket].numFree -= n;
-		cachePtr->buckets[bucket].numFree = n;
+		sharedPtr->buckets[bucket].nfree -= n;
+		cachePtr->buckets[bucket].nfree = n;
 		while (--n > 0) {
-		    blockPtr = blockPtr->nextBlock;
+    		    blockPtr = blockPtr->b_next;
 		}
-		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
-		blockPtr->nextBlock = NULL;
+		sharedPtr->buckets[bucket].firstPtr = blockPtr->b_next;
+		blockPtr->b_next = NULL;
 	    }
 	}
 	UnlockBucket(cachePtr, bucket);
     }
-
-    if (cachePtr->buckets[bucket].numFree == 0) {
-	register size_t size;
+    
+    if (cachePtr->buckets[bucket].nfree == 0) {
 
 	/*
-	 * 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].numFree > 0) {
-		size = bucketInfo[n].blockSize;
+    	    if (cachePtr->buckets[n].nfree > 0) {
+		size = binfo[n].blocksize;
 		blockPtr = cachePtr->buckets[n].firstPtr;
-		cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
-		cachePtr->buckets[n].numFree--;
+		cachePtr->buckets[n].firstPtr = blockPtr->b_next;
+		--cachePtr->buckets[n].nfree;
 		break;
 	    }
 	}
@@ -974,26 +964,26 @@ GetBlocks(
 	 * Split the larger block into smaller blocks for this bucket.
 	 */
 
-	n = size / bucketInfo[bucket].blockSize;
-	cachePtr->buckets[bucket].numFree = n;
+	n = size / binfo[bucket].blocksize;
+	cachePtr->buckets[bucket].nfree = n;
 	cachePtr->buckets[bucket].firstPtr = blockPtr;
 	while (--n > 0) {
-	    blockPtr->nextBlock = (Block *)
-		((char *) blockPtr + bucketInfo[bucket].blockSize);
-	    blockPtr = blockPtr->nextBlock;
+	    blockPtr->b_next = (Block *) 
+		((char *) blockPtr + binfo[bucket].blocksize);
+	    blockPtr = blockPtr->b_next;
 	}
-	blockPtr->nextBlock = NULL;
+	blockPtr->b_next = 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.
@@ -1005,13 +995,13 @@ GetBlocks(
  */
 
 void
-TclFinalizeThreadAlloc(void)
+TclFinalizeThreadAlloc()
 {
     unsigned int i;
 
     for (i = 0; i < NBUCKETS; ++i) {
-	TclpFreeAllocMutex(bucketInfo[i].lockPtr);
-	bucketInfo[i].lockPtr = NULL;
+        TclpFreeAllocMutex(binfo[i].lockPtr); 
+        binfo[i].lockPtr = NULL;
     }
 
     TclpFreeAllocMutex(objLockPtr);
@@ -1023,37 +1013,15 @@ TclFinalizeThreadAlloc(void)
     TclpFreeAllocCache(NULL);
 }
 
-#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.
- *
- *----------------------------------------------------------------------
- */
+#else /* ! defined(TCL_THREADS) && ! defined(USE_THREAD_ALLOC) */
 
-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.
@@ -1065,16 +1033,9 @@ Tcl_GetMemoryInfo(
  */
 
 void
-TclFinalizeThreadAlloc(void)
+TclFinalizeThreadAlloc()
 {
-    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 && USE_THREAD_ALLOC */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
+
+#endif /* TCL_THREADS */
diff --git a/generic/tclThreadJoin.c b/generic/tclThreadJoin.c
index 4b09e1c..f3c6abd 100644
--- a/generic/tclThreadJoin.c
+++ b/generic/tclThreadJoin.c
@@ -1,66 +1,69 @@
-/*
+/* 
  * tclThreadJoin.c --
  *
- *	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.
+ *	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.
  *
  * 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"
 
-#ifdef WIN32
+#if defined(WIN32) || defined(MAC_TCL)
 
-/*
- * 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;
+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
@@ -69,139 +72,135 @@ 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(
-    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(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. */
 {
-    JoinableThread *threadPtr;
-
-    /*
-     * Steps done here:
+    /* 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.
      */
 
-    Tcl_MutexLock(&joinMutex);
+    JoinableThread* threadPtr;
 
-    threadPtr = firstThreadPtr;
-    while (threadPtr!=NULL && threadPtr->id!=id) {
-	threadPtr = threadPtr->nextThreadPtr;
-    }
+    Tcl_MutexLock (&joinMutex);
+
+    for (threadPtr = firstThreadPtr;
+	 (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
+	 threadPtr = threadPtr->nextThreadPtr)
+        /* empty body */
+      ;
 
-    if (threadPtr == NULL) {
-	/*
-	 * Thread not found. Either not joinable, or already waited upon and
-	 * exited. Whatever, an error is in order.
+    if (threadPtr == (JoinableThread*) 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 = firstThreadPtr;
+        JoinableThread* prevThreadPtr;
+
+	for (prevThreadPtr = firstThreadPtr;
+	     prevThreadPtr->nextThreadPtr != threadPtr;
+	     prevThreadPtr = prevThreadPtr->nextThreadPtr)
+	    /* empty body */
+	  ;
 
-	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(threadPtr);
+    Tcl_ConditionFinalize (&threadPtr->cond);
+    Tcl_MutexFinalize (&threadPtr->threadMutex);
+    ckfree ((VOID*) threadPtr);
 
     return TCL_OK;
 }
@@ -212,37 +211,39 @@ TclJoinThread(
  * 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(
-    Tcl_ThreadId id)		/* The thread to remember as joinable */
+VOID
+TclRememberJoinableThread(id)
+    Tcl_ThreadId id; /* The thread to remember as joinable */
 {
-    JoinableThread *threadPtr;
+    JoinableThread* threadPtr;
 
-    threadPtr = 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);
 }
 
 /*
@@ -250,9 +251,9 @@ TclRememberJoinableThread(
  *
  * 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.
@@ -263,54 +264,46 @@ TclRememberJoinableThread(
  *----------------------------------------------------------------------
  */
 
-void
-TclSignalExitThread(
-    Tcl_ThreadId id,		/* Id of the thread signaling its exit. */
-    int result)			/* The result from the thread. */
+VOID
+TclSignalExitThread(id,result)
+    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);
 
-    threadPtr = firstThreadPtr;
-    while ((threadPtr != NULL) && (threadPtr->id != id)) {
-	threadPtr = threadPtr->nextThreadPtr;
-    }
+    for (threadPtr = firstThreadPtr;
+	 (threadPtr != (JoinableThread*) NULL) && (threadPtr->id != id);
+	 threadPtr = threadPtr->nextThreadPtr)
+        /* empty body */
+      ;
 
-    if (threadPtr == NULL) {
-	/*
-	 * Thread not found. Not joinable. No problem, nothing to do.
+    if (threadPtr == (JoinableThread*) 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:
- */
+
+#endif /* WIN32 || MAC_TCL */
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
deleted file mode 100644
index f24e334..0000000
--- a/generic/tclThreadStorage.c
+++ /dev/null
@@ -1,373 +0,0 @@
-/*
- * tclThreadStorage.c --
- *
- *	This file implements platform independent thread storage operations to
- *	work around system limits on the number of thread-specific variables.
- *
- * Copyright (c) 2003-2004 by Joe Mistachkin
- * Copyright (c) 2008 by George Peter Staplin
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-#ifdef TCL_THREADS
-#include <signal.h>
-
-/*
- * IMPLEMENTATION NOTES:
- *
- * The primary idea is that we create one platform-specific TSD slot, and use
- * it for storing a table pointer. Each Tcl_ThreadDataKey has an offset into
- * the table of TSD values. We don't use more than 1 platform-specific TSD
- * slot, because there is a hard limit on the number of TSD slots. Valid key
- * offsets are greater than 0; 0 is for the initialized Tcl_ThreadDataKey.
- */
-
-/*
- * The master collection of information about TSDs. This is shared across the
- * whole process, and includes the mutex used to protect it.
- */
-
-static struct TSDMaster {
-    void *key;			/* Key into the system TSD structure. The
-				 * collection of Tcl TSD values for a
-				 * particular thread will hang off the
-				 * back-end of this. */
-    sig_atomic_t counter;	/* The number of different Tcl TSDs used
-				 * across *all* threads. This is a strictly
-				 * increasing value. */
-    Tcl_Mutex mutex;		/* Protection for the rest of this structure,
-				 * which holds per-process data. */
-} tsdMaster = { NULL, 0, NULL };
-
-/*
- * The type of the data held per thread in a system TSD.
- */
-
-typedef struct TSDTable {
-    ClientData *tablePtr;	/* The table of Tcl TSDs. */
-    sig_atomic_t allocated;	/* The size of the table in the current
-				 * thread. */
-} TSDTable;
-
-/*
- * The actual type of Tcl_ThreadDataKey.
- */
-
-typedef union TSDUnion {
-    volatile sig_atomic_t offset;
-				/* The type is really an offset into the
-				 * thread-local table of TSDs, which is this
-				 * field. */
-    void *ptr;			/* For alignment purposes only. Not actually
-				 * accessed through this. */
-} TSDUnion;
-
-/*
- * Forward declarations of functions in this file.
- */
-
-static TSDTable *	TSDTableCreate(void);
-static void		TSDTableDelete(TSDTable *tsdTablePtr);
-static void		TSDTableGrow(TSDTable *tsdTablePtr,
-			    sig_atomic_t atLeast);
-
-/*
- * Allocator and deallocator for a TSDTable structure.
- */
-
-static TSDTable *
-TSDTableCreate(void)
-{
-    TSDTable *tsdTablePtr;
-    sig_atomic_t i;
-
-    tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0);
-    if (tsdTablePtr == NULL) {
-	Tcl_Panic("unable to allocate TSDTable");
-    }
-
-    tsdTablePtr->allocated = 8;
-    tsdTablePtr->tablePtr =
-	    TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0);
-    if (tsdTablePtr->tablePtr == NULL) {
-	Tcl_Panic("unable to allocate TSDTable");
-    }
-
-    for (i = 0; i < tsdTablePtr->allocated; ++i) {
-	tsdTablePtr->tablePtr[i] = NULL;
-    }
-
-    return tsdTablePtr;
-}
-
-static void
-TSDTableDelete(
-    TSDTable *tsdTablePtr)
-{
-    sig_atomic_t i;
-
-    for (i=0 ; i<tsdTablePtr->allocated ; i++) {
-	if (tsdTablePtr->tablePtr[i] != NULL) {
-	    /*
-	     * These values were allocated in Tcl_GetThreadData in tclThread.c
-	     * and must now be deallocated or they will leak.
-	     */
-
-	    ckfree(tsdTablePtr->tablePtr[i]);
-	}
-    }
-
-    TclpSysFree(tsdTablePtr->tablePtr);
-    TclpSysFree(tsdTablePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TSDTableGrow --
- *
- *	This procedure makes the passed TSDTable grow to fit the atLeast
- *	value.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The table is enlarged.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-TSDTableGrow(
-    TSDTable *tsdTablePtr,
-    sig_atomic_t atLeast)
-{
-    sig_atomic_t newAllocated = tsdTablePtr->allocated * 2;
-    ClientData *newTablePtr;
-    sig_atomic_t i;
-
-    if (newAllocated <= atLeast) {
-	newAllocated = atLeast + 10;
-    }
-
-    newTablePtr = TclpSysRealloc(tsdTablePtr->tablePtr,
-	    sizeof(ClientData) * newAllocated);
-    if (newTablePtr == NULL) {
-	Tcl_Panic("unable to reallocate TSDTable");
-    }
-
-    for (i = tsdTablePtr->allocated; i < newAllocated; ++i) {
-	newTablePtr[i] = NULL;
-    }
-
-    tsdTablePtr->allocated = newAllocated;
-    tsdTablePtr->tablePtr = newTablePtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclThreadStorageKeyGet --
- *
- *    This procedure gets the value associated with the passed key.
- *
- * Results:
- *	A pointer value associated with the Tcl_ThreadDataKey or NULL.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void *
-TclThreadStorageKeyGet(
-    Tcl_ThreadDataKey *dataKeyPtr)
-{
-    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
-    ClientData resultPtr = NULL;
-    TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
-    sig_atomic_t offset = keyPtr->offset;
-
-    if ((tsdTablePtr != NULL) && (offset > 0)
-	    && (offset < tsdTablePtr->allocated)) {
-	resultPtr = tsdTablePtr->tablePtr[offset];
-    }
-    return resultPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclThreadStorageKeySet --
- *
- *	This procedure set an association of value with the key passed. The
- *	associated value may be retrieved with TclThreadDataKeyGet().
- * 
- * Results:
- *	None.
- *
- * Side effects:
- *	The thread-specific table may be created or reallocated. 
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclThreadStorageKeySet(
-    Tcl_ThreadDataKey *dataKeyPtr,
-    void *value)
-{
-    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
-    TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
-
-    if (tsdTablePtr == NULL) {
-	tsdTablePtr = TSDTableCreate();
-	TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
-    }
-
-    /*
-     * Get the lock while we check if this TSD is new or not. Note that this
-     * is the only place where Tcl_ThreadDataKey values are set. We use a
-     * double-checked lock to try to avoid having to grab this lock a lot,
-     * since it is on quite a few critical paths and will only get set once in
-     * each location.
-     */
-
-    if (keyPtr->offset == 0) {
-	Tcl_MutexLock(&tsdMaster.mutex);
-	if (keyPtr->offset == 0) {
-	    /*
-	     * The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
-	     */
-
-	    keyPtr->offset = ++tsdMaster.counter;
-	}
-	Tcl_MutexUnlock(&tsdMaster.mutex);
-    }
-
-    /*
-     * Check if this is the first time this Tcl_ThreadDataKey has been used
-     * with the current thread. Note that we don't need to hold a lock when
-     * doing this, as we are *definitely* the only point accessing this
-     * tsdTablePtr right now; it's thread-local.
-     */
-
-    if (keyPtr->offset >= tsdTablePtr->allocated) {
-	TSDTableGrow(tsdTablePtr, keyPtr->offset);
-    }
-
-    /*
-     * Set the value in the Tcl thread-local variable.
-     */
-
-    tsdTablePtr->tablePtr[keyPtr->offset] = value;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeThreadDataThread --
- *
- *	This procedure finalizes the data for a single thread.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The TSDTable is deleted/freed.
- *
- *----------------------------------------------------------------------
- */
-
-void 
-TclFinalizeThreadDataThread(void)
-{
-    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
-
-    if (tsdTablePtr != NULL) {
-	TSDTableDelete(tsdTablePtr);
-	TclpThreadSetMasterTSD(tsdMaster.key, NULL);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitializeThreadStorage --
- *
- *	This procedure initializes the TSD subsystem with per-platform code.
- *	This should be called before any Tcl threads are created.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocates a system TSD.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclInitThreadStorage(void)
-{
-    tsdMaster.key = TclpThreadCreateKey();
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclFinalizeThreadStorage --
- *
- *	This procedure cleans up the thread storage data key for all threads.
- *	IMPORTANT: All Tcl threads must be finalized before calling this!
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Releases the thread data key.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclFinalizeThreadStorage(void)
-{
-    TclpThreadDeleteKey(tsdMaster.key);
-    tsdMaster.key = NULL;
-}
-
-#else /* !TCL_THREADS */
-/*
- * Stub functions for non-threaded builds
- */
-
-void
-TclInitThreadStorage(void)
-{
-}
-
-void
-TclFinalizeThreadDataThread(void)
-{
-}
-
-void
-TclFinalizeThreadStorage(void)
-{
-}
-#endif /* TCL_THREADS */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 22b5995..d298e5b 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -1,79 +1,70 @@
-/*
+/* 
  * 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.
- * Copyright (c) 2006-2008 by Joe Mistachkin.  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 USE_TCL_STUBS
-#   define USE_TCL_STUBS
-#endif
 #include "tclInt.h"
 
 #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 {
-    Tcl_ThreadId threadId;	/* Tcl ID for this thread */
-    Tcl_Interp *interp;		/* Main interpreter for this thread */
-    int flags;			/* See the TP_ defines below... */
-    struct ThreadSpecificData *nextPtr;
-				/* List for "thread names" */
-    struct ThreadSpecificData *prevPtr;
-				/* List for "thread names" */
+    Tcl_ThreadId  threadId;          /* Tcl ID for this thread */
+    Tcl_Interp *interp;              /* Main interpreter for this thread */
+    int flags;                       /* See the TP_ defines below... */
+    struct ThreadSpecificData *nextPtr;	/* List for "thread names" */
+    struct ThreadSpecificData *prevPtr;	/* List for "thread names" */
 } 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 ThreadSpecificData *threadList = NULL;
+static struct ThreadSpecificData *threadList;
 
 /*
  * The following bit-values are legal for the "flags" field of the
  * ThreadSpecificData structure.
  */
-
-#define TP_Dying		0x001 /* This thread is being canceled */
+#define TP_Dying               0x001 /* This thread is being cancelled */
 
 /*
  * An instance of the following structure contains all information that is
  * passed into a new thread when the thread is created using either the
- * "thread create" Tcl command or the ThreadCreate() C function.
+ * "thread create" Tcl command or the TclCreateThread() C function.
  */
 
 typedef struct ThreadCtrl {
-    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. */
+    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;
 
 /*
@@ -84,8 +75,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 {
@@ -108,38 +99,41 @@ static ThreadEventResult *resultList;
  * This is for simple error handling when a thread script exits badly.
  */
 
-static Tcl_ThreadId mainThreadId;
 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)
 
-static int		ThreadObjCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
-static int		ThreadCreate(Tcl_Interp *interp, const char *script,
-			    int joinable);
-static int		ThreadList(Tcl_Interp *interp);
-static int		ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
-			    const char *script, int wait);
-static int		ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id,
-			    const char *result, int flags);
-
-static 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);
-extern int		Tcltest_Init(Tcl_Interp *interp);
+#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));
+
+#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));
+
 
 /*
  *----------------------------------------------------------------------
@@ -149,7 +143,7 @@ extern int		Tcltest_Init(Tcl_Interp *interp);
  *	Initialize the test thread command.
  *
  * Results:
- *	TCL_OK if the package was properly initialized.
+ *      TCL_OK if the package was properly initialized.
  *
  * Side effects:
  *	Add the "testthread" command to the interp.
@@ -158,20 +152,15 @@ extern int		Tcltest_Init(Tcl_Interp *interp);
  */
 
 int
-TclThread_Init(
-    Tcl_Interp *interp)		/* The current Tcl interpreter */
+TclThread_Init(interp)
+    Tcl_Interp *interp; /* The current Tcl interpreter */
 {
-    /*
-     * If the main thread Id has not been set, do it now.
-     */
-
-    Tcl_MutexLock(&threadMutex);
-    if (mainThreadId == 0) {
-	mainThreadId = Tcl_GetCurrentThread();
+    
+    Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd, 
+	    (ClientData)NULL ,NULL);
+    if (Tcl_PkgProvide(interp, "Thread", "1.0" ) != TCL_OK) {
+	return TCL_ERROR;
     }
-    Tcl_MutexUnlock(&threadMutex);
-
-    Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
     return TCL_OK;
 }
 
@@ -179,17 +168,15 @@ TclThread_Init(
 /*
  *----------------------------------------------------------------------
  *
- * ThreadObjCmd --
+ * 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 cancel ?-unwind? id ?result?
  *	thread create ?-joinable? ?script?
- *	thread send ?-async? id script
- *	thread event
+ *	thread send id ?-async? script
  *	thread exit
- *	thread id ?-main?
+ *	thread info id
  *	thread names
  *	thread wait
  *	thread errorproc proc
@@ -205,36 +192,31 @@ TclThread_Init(
  */
 
 	/* ARGSUSED */
-static int
-ThreadObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     int option;
-    static const char *const threadOptions[] = {
-	"cancel", "create", "event", "exit", "id",
-	"join", "names", "send", "wait", "errorproc",
-	NULL
-    };
-    enum options {
-	THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, 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",
+				    (char *) 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 ?arg ...?");
+	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.
      */
 
@@ -247,241 +229,166 @@ ThreadObjCmd(
     }
 
     switch ((enum options)option) {
-    case THREAD_CANCEL: {
-	long id;
-	const char *result;
-	int flags, arg;
-
-	if ((objc < 3) || (objc > 5)) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?");
-	    return TCL_ERROR;
-	}
-	flags = 0;
-	arg = 2;
-	if ((objc == 4) || (objc == 5)) {
-	    if (strcmp("-unwind", Tcl_GetString(objv[arg])) == 0) {
-		flags = TCL_CANCEL_UNWIND;
-		arg++;
-	    }
-	}
-	if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	arg++;
-	if (arg < objc) {
-	    result = Tcl_GetString(objv[arg]);
-	} else {
-	    result = NULL;
-	}
-	return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags);
-    }
-    case THREAD_CREATE: {
-	const char *script;
-	int joinable, len;
+	case THREAD_CREATE: {
+	    char *script;
+	    int   joinable, len;
 
-	if (objc == 2) {
-	    /*
-	     * Neither joinable nor special script
-	     */
+	    if (objc == 2) {
+	        /* Neither joinable nor special 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.
-	     */
+	        joinable = 0;
+		script   = "testthread wait";	/* Just enter the event loop */
 
-	    script = Tcl_GetStringFromObj(objv[2], &len);
+	    } else if (objc == 3) {
+	        /* Possibly -joinable, then no special script,
+		 * no joinable, then its a script.
+		 */
 
-	    if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
-		    (0 == strncmp(script, "-joinable", (size_t) len))) {
-		joinable = 1;
-		script = "testthread wait";	/* Just enter event loop */
-	    } else {
-		/*
-		 * Remember the script
+	        script = Tcl_GetString(objv[2]);
+		len    = strlen (script);
+
+		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 = 0;
-	    }
-	} else if (objc == 4) {
-	    /*
-	     * Definitely a script available, but is the flag -joinable?
-	     */
+	        script = Tcl_GetString(objv[2]);
+		len    = strlen (script);
 
-	    script = Tcl_GetStringFromObj(objv[2], &len);
-	    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;
+		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;
+	    }
+	    return TclCreateThread(interp, script, joinable);
 	}
-	return ThreadCreate(interp, script, joinable);
-    }
-    case THREAD_EXIT:
-	if (objc > 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    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;
 	}
-	ListRemove(NULL);
-	Tcl_ExitThread(0);
-	return TCL_OK;
-    case THREAD_ID:
-	if (objc == 2 || objc == 3) {
-	    Tcl_Obj *idObj;
-
-	    /*
-	     * Check if they want the main thread id or the current thread id.
-	     */
-
+	case THREAD_ID:
 	    if (objc == 2) {
-		idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
-	    } else if (objc == 3
-		    && strcmp("-main", Tcl_GetString(objv[2])) == 0) {
-		Tcl_MutexLock(&threadMutex);
-		idObj = Tcl_NewLongObj((long)(size_t)mainThreadId);
-		Tcl_MutexUnlock(&threadMutex);
+		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;
 
-	    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;
-
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "id");
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-
-	result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
-	if (result == TCL_OK) {
-	    Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
-	} else {
-	    char buf[20];
+	    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;
+	    }
 
-	    TclFormatInt(buf, 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 ThreadList(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;
+	    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 == 5) {
-	    if (strcmp("-async", Tcl_GetString(objv[2])) != 0) {
-		Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
+	case THREAD_NAMES: {
+	    if (objc > 2) {
+		Tcl_WrongNumArgs(interp, 2, objv, NULL);
 		return TCL_ERROR;
 	    }
-	    wait = 0;
-	    arg = 3;
-	} else {
-	    wait = 1;
-	    arg = 2;
+	    return TclThreadList(interp);
 	}
-	if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	arg++;
-	script = Tcl_GetString(objv[arg]);
-	return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
-    }
-    case THREAD_EVENT: {
-	if (objc > 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(
-		Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)));
-	return TCL_OK;
-    }
-    case THREAD_ERRORPROC: {
-	/*
-	 * Arrange for this proc to handle thread death errors.
-	 */
-
-	const char *proc;
+	case THREAD_SEND: {
+	    long id;
+	    char *script;
+	    int wait, arg;
 
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
-	    return TCL_ERROR;
-	}
-	Tcl_MutexLock(&threadMutex);
-	errorThreadId = Tcl_GetCurrentThread();
-	if (errorProcString) {
-	    ckfree(errorProcString);
+	    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) {
+		return TCL_ERROR;
+	    }
+	    arg++;
+	    script = Tcl_GetString(objv[arg]);
+	    return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait);
 	}
-	proc = Tcl_GetString(objv[2]);
-	errorProcString = ckalloc(strlen(proc) + 1);
-	strcpy(errorProcString, proc);
-	Tcl_MutexUnlock(&threadMutex);
-	return TCL_OK;
-    }
-    case THREAD_WAIT:
-	if (objc > 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "");
-	    return TCL_ERROR;
+	case THREAD_WAIT: {
+	    while (1) {
+		(void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
+	    }
 	}
-	while (1) {
+	case THREAD_ERRORPROC: {
 	    /*
-	     * If the script has been unwound, bail out immediately. This does
-	     * not follow the recommended guidelines for how extensions should
-	     * handle the script cancellation functionality because this is
-	     * not a "normal" extension. Most extensions do not have a command
-	     * that simply enters an infinite Tcl event loop. Normal
-	     * extensions should not specify the TCL_CANCEL_UNWIND when
-	     * calling Tcl_Canceled to check if the command has been canceled.
+	     * Arrange for this proc to handle thread death errors.
 	     */
 
-	    if (Tcl_Canceled(interp,
-		    TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) {
-		break;
+	    char *proc;
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc");
+		return TCL_ERROR;
 	    }
-	    (void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
+	    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;
 	}
-
-	/*
-	 * If we get to this point, we have been canceled by another thread,
-	 * which is considered to be an "error".
-	 */
-
-	ThreadErrorProc(interp);
-	return TCL_OK;
     }
     return TCL_OK;
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
- * ThreadCreate --
+ * 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.
@@ -493,11 +400,11 @@ ThreadObjCmd(
  */
 
 	/* ARGSUSED */
-static int
-ThreadCreate(
-    Tcl_Interp *interp,		/* Current interpreter. */
-    const char *script,		/* Script to execute */
-    int joinable)		/* Flag, joinable thread or not */
+int
+TclCreateThread(interp, script, joinable)
+    Tcl_Interp *interp;			/* Current interpreter. */
+    char *script;			/* Script to execute */
+    int         joinable;		/* Flag, joinable thread or not */
 {
     ThreadCtrl ctrl;
     Tcl_ThreadId id;
@@ -510,10 +417,10 @@ ThreadCreate(
 
     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);
-	ckfree(ctrl.script);
+        Tcl_AppendResult(interp,"can't create a new thread",NULL);
+	ckfree((void*)ctrl.script);
 	return TCL_ERROR;
     }
 
@@ -524,7 +431,7 @@ ThreadCreate(
     Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
     Tcl_MutexUnlock(&threadMutex);
     Tcl_ConditionFinalize(&ctrl.condWait);
-    Tcl_SetObjResult(interp, Tcl_NewLongObj((long)(size_t)id));
+    Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id));
     return TCL_OK;
 }
 
@@ -533,57 +440,45 @@ ThreadCreate(
  *
  * 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)
+NewTestThread(clientData)
+    ClientData clientData;
 {
-    ThreadCtrl *ctrlPtr = clientData;
+    ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     int result;
     char *threadEvalScript;
 
     /*
-     * Initialize the interpreter. This should be more general.
+     * Initialize the interpreter.  This should be more general.
      */
 
     tsdPtr->interp = Tcl_CreateInterp();
     result = Tcl_Init(tsdPtr->interp);
-    if (result != TCL_OK) {
-	ThreadErrorProc(tsdPtr->interp);
-    }
-
-    /*
-     * This is part of the test facility. Initialize _ALL_ test commands for
-     * use by the new thread.
-     */
-
-    result = Tcltest_Init(tsdPtr->interp);
-    if (result != TCL_OK) {
-	ThreadErrorProc(tsdPtr->interp);
-    }
+    result = TclThread_Init(tsdPtr->interp);
 
     /*
      * Update the list of threads.
@@ -591,16 +486,14 @@ NewTestThread(
 
     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 = ckalloc(strlen(ctrlPtr->script) + 1);
+    threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1);
     strcpy(threadEvalScript, ctrlPtr->script);
 
-    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);
+    Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
 
     /*
      * Notify the parent we are alive.
@@ -613,7 +506,7 @@ NewTestThread(
      * Run the script.
      */
 
-    Tcl_Preserve(tsdPtr->interp);
+    Tcl_Preserve((ClientData) tsdPtr->interp);
     result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
     if (result != TCL_OK) {
 	ThreadErrorProc(tsdPtr->interp);
@@ -623,9 +516,9 @@ NewTestThread(
      * Clean up.
      */
 
-    Tcl_DeleteInterp(tsdPtr->interp);
-    Tcl_Release(tsdPtr->interp);
     ListRemove(tsdPtr);
+    Tcl_Release((ClientData) tsdPtr->interp);
+    Tcl_DeleteInterp(tsdPtr->interp);
     Tcl_ExitThread(result);
 
     TCL_THREAD_CREATE_RETURN;
@@ -636,27 +529,25 @@ NewTestThread(
  *
  * 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(
-    Tcl_Interp *interp)		/* Interp that failed */
+ThreadErrorProc(interp)
+    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];
-
-    TclFormatInt(buf, (size_t) Tcl_GetCurrentThread());
+    sprintf(buf, "%ld", (long) Tcl_GetCurrentThread());
 
     errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
     if (errorProcString == NULL) {
@@ -671,7 +562,7 @@ ThreadErrorProc(
 	argv[1] = buf;
 	argv[2] = errorInfo;
 	script = Tcl_Merge(3, argv);
-	ThreadSend(interp, errorThreadId, script, 0);
+	TclThreadSend(interp, errorThreadId, script, 0);
 	ckfree(script);
     }
 }
@@ -682,21 +573,20 @@ ThreadErrorProc(
  *
  * 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(
-    ThreadSpecificData *tsdPtr)
+ListUpdateInner(tsdPtr)
+    ThreadSpecificData *tsdPtr;
 {
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -715,21 +605,20 @@ ListUpdateInner(
  *
  * 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(
-    ThreadSpecificData *tsdPtr)
+ListRemove(tsdPtr)
+    ThreadSpecificData *tsdPtr;
 {
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -744,14 +633,14 @@ ListRemove(
 	tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
     }
     tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
-    tsdPtr->interp = NULL;
     Tcl_MutexUnlock(&threadMutex);
 }
+
 
 /*
  *------------------------------------------------------------------------
  *
- * ThreadList --
+ * TclThreadList --
  *
  *    Return a list of threads running Tcl interpreters.
  *
@@ -763,9 +652,9 @@ ListRemove(
  *
  *------------------------------------------------------------------------
  */
-static int
-ThreadList(
-    Tcl_Interp *interp)
+int
+TclThreadList(interp)
+    Tcl_Interp *interp;
 {
     ThreadSpecificData *tsdPtr;
     Tcl_Obj *listPtr;
@@ -774,17 +663,18 @@ ThreadList(
     Tcl_MutexLock(&threadMutex);
     for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
 	Tcl_ListObjAppendElement(interp, listPtr,
-		Tcl_NewLongObj((long)(size_t)tsdPtr->threadId));
+		Tcl_NewLongObj((long)tsdPtr->threadId));
     }
     Tcl_MutexUnlock(&threadMutex);
     Tcl_SetObjResult(interp, listPtr);
     return TCL_OK;
 }
+
 
 /*
  *------------------------------------------------------------------------
  *
- * ThreadSend --
+ * TclThreadSend --
  *
  *    Send a script to another thread.
  *
@@ -796,13 +686,12 @@ ThreadList(
  *
  *------------------------------------------------------------------------
  */
-
-static int
-ThreadSend(
-    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. */
+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. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
     ThreadEvent *threadEventPtr;
@@ -810,7 +699,7 @@ ThreadSend(
     int found, code;
     Tcl_ThreadId threadId = (Tcl_ThreadId) id;
 
-    /*
+    /* 
      * Verify the thread exists.
      */
 
@@ -829,26 +718,26 @@ ThreadSend(
     }
 
     /*
-     * 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()) {
-	Tcl_MutexUnlock(&threadMutex);
+        Tcl_MutexUnlock(&threadMutex);
 	return Tcl_GlobalEval(interp, script);
     }
 
-    /*
+    /* 
      * Create the event for its event queue.
      */
 
-    threadEventPtr = ckalloc(sizeof(ThreadEvent));
+    threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent));
     threadEventPtr->script = ckalloc(strlen(script) + 1);
     strcpy(threadEventPtr->script, script);
     if (!wait) {
 	resultPtr = threadEventPtr->resultPtr = NULL;
     } else {
-	resultPtr = ckalloc(sizeof(ThreadEventResult));
+	resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
 	threadEventPtr->resultPtr = resultPtr;
 
 	/*
@@ -861,7 +750,7 @@ ThreadSend(
 	resultPtr->errorInfo = NULL;
 	resultPtr->errorCode = NULL;
 
-	/*
+	/* 
 	 * Maintain the cleanup list.
 	 */
 
@@ -881,7 +770,7 @@ ThreadSend(
      */
 
     threadEventPtr->event.proc = ThreadEventProc;
-    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
+    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr, 
 	    TCL_QUEUE_TAIL);
     Tcl_ThreadAlert(threadId);
 
@@ -890,13 +779,13 @@ ThreadSend(
 	return TCL_OK;
     }
 
-    /*
+    /* 
      * Block on the results and then get them.
      */
 
     Tcl_ResetResult(interp);
     while (resultPtr->result == NULL) {
-	Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
+        Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
     }
 
     /*
@@ -931,66 +820,11 @@ ThreadSend(
     Tcl_ConditionFinalize(&resultPtr->done);
     code = resultPtr->code;
 
-    ckfree(resultPtr);
+    ckfree((char *) resultPtr);
 
     return code;
 }
-
-/*
- *------------------------------------------------------------------------
- *
- * ThreadCancel --
- *
- *    Cancels a script in another thread.
- *
- * Results:
- *    A standard Tcl result.
- *
- * Side effects:
- *    None.
- *
- *------------------------------------------------------------------------
- */
-
-static int
-ThreadCancel(
-    Tcl_Interp *interp,		/* The current interpreter. */
-    Tcl_ThreadId id,		/* Thread Id of other interpreter. */
-    const char *result,		/* The result or NULL for default. */
-    int flags)			/* Flags for Tcl_CancelEval. */
-{
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    int found;
-    Tcl_ThreadId threadId = (Tcl_ThreadId) id;
-
-    /*
-     * Verify the thread exists.
-     */
 
-    Tcl_MutexLock(&threadMutex);
-    found = 0;
-    for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
-	if (tsdPtr->threadId == threadId) {
-	    found = 1;
-	    break;
-	}
-    }
-    if (!found) {
-	Tcl_MutexUnlock(&threadMutex);
-	Tcl_AppendResult(interp, "invalid thread id", NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Since Tcl_CancelEval can be safely called from any thread,
-     * we do it now.
-     */
-
-    Tcl_MutexUnlock(&threadMutex);
-    Tcl_ResetResult(interp);
-    return Tcl_CancelEval(tsdPtr->interp,
-    	(result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags);
-}
 
 /*
  *------------------------------------------------------------------------
@@ -1007,18 +841,17 @@ ThreadCancel(
  *
  *------------------------------------------------------------------------
  */
-
 static int
-ThreadEventProc(
-    Tcl_Event *evPtr,		/* Really ThreadEvent */
-    int mask)
+ThreadEventProc(evPtr, mask)
+    Tcl_Event *evPtr;		/* Really ThreadEvent */
+    int mask;
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    ThreadEvent *threadEventPtr = (ThreadEvent *) evPtr;
+    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;
@@ -1026,11 +859,13 @@ ThreadEventProc(
 	errorCode = "THREAD";
 	errorInfo = "";
     } else {
-	Tcl_Preserve(interp);
+	Tcl_Preserve((ClientData) interp);
 	Tcl_ResetResult(interp);
-	Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
+	Tcl_CreateThreadExitHandler(ThreadFreeProc,
+		(ClientData) threadEventPtr->script);
 	code = Tcl_GlobalEval(interp, threadEventPtr->script);
-	Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
+	Tcl_DeleteThreadExitHandler(ThreadFreeProc,
+		(ClientData) threadEventPtr->script);
 	if (code != TCL_OK) {
 	    errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
 	    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
@@ -1057,7 +892,7 @@ ThreadEventProc(
 	Tcl_MutexUnlock(&threadMutex);
     }
     if (interp != NULL) {
-	Tcl_Release(interp);
+	Tcl_Release((ClientData) interp);
     }
     return 1;
 }
@@ -1078,14 +913,13 @@ ThreadEventProc(
  *
  *------------------------------------------------------------------------
  */
-
      /* ARGSUSED */
 static void
-ThreadFreeProc(
-    ClientData clientData)
+ThreadFreeProc(clientData)
+    ClientData clientData;
 {
     if (clientData) {
-	ckfree(clientData);
+	ckfree((char *) clientData);
     }
 }
 
@@ -1105,23 +939,20 @@ ThreadFreeProc(
  *
  *------------------------------------------------------------------------
  */
-
      /* ARGSUSED */
 static int
-ThreadDeleteEvent(
-    Tcl_Event *eventPtr,	/* Really ThreadEvent */
-    ClientData clientData)	/* dummy */
+ThreadDeleteEvent(eventPtr, clientData)
+    Tcl_Event *eventPtr;		/* Really ThreadEvent */
+    ClientData clientData;		/* dummy */
 {
     if (eventPtr->proc == ThreadEventProc) {
-	ckfree(((ThreadEvent *) eventPtr)->script);
+	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);
 }
 
@@ -1130,48 +961,41 @@ ThreadDeleteEvent(
  *
  * 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)
+ThreadExitProc(clientData)
+    ClientData clientData;
 {
-    char *threadEvalScript = clientData;
+    char *threadEvalScript = (char *) clientData;
     ThreadEventResult *resultPtr, *nextPtr;
     Tcl_ThreadId self = Tcl_GetCurrentThread();
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-    if (tsdPtr->interp != NULL) {
-	ListRemove(tsdPtr);
-    }
 
     Tcl_MutexLock(&threadMutex);
 
     if (threadEvalScript) {
-	ckfree(threadEvalScript);
+	ckfree((char *) threadEvalScript);
 	threadEvalScript = NULL;
     }
-    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);
+    Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);
 
     for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
 	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 {
@@ -1182,17 +1006,16 @@ ThreadExitProc(
 	    }
 	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
 	    resultPtr->eventPtr->resultPtr = NULL;
-	    ckfree(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.
 	     */
 
-	    const char *msg = "target thread died";
-
-	    resultPtr->result = ckalloc(strlen(msg) + 1);
+	    char *msg = "target thread died";
+	    resultPtr->result = ckalloc(strlen(msg)+1);
 	    strcpy(resultPtr->result, msg);
 	    resultPtr->code = TCL_ERROR;
 	    Tcl_ConditionNotify(&resultPtr->done);
@@ -1200,12 +1023,5 @@ ThreadExitProc(
     }
     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 cf91dca..d472b17 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,73 +6,75 @@
  *
  * 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;	/* 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. */
+    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. */
 } 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;		/* Function to call. */
+    Tcl_IdleProc (*proc);	/* Procedure to call. */
     ClientData clientData;	/* Value to pass to proc. */
     int generation;		/* Used to distinguish older handlers from
 				 * recently-created ones. */
@@ -80,88 +82,53 @@ 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;
 
 /*
- * 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);
+ * Prototypes for procedures referenced only in this file:
  */
 
-#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)
-
-#define TCL_TIME_DIFF_MS_CEILING(t1, t2) \
-    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
-	    ((long)(t1).usec - (long)(t2).usec + 999)/1000)
-
-/*
- * Sleeps under that number of milliseconds don't get double-checked
- * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s.
- */
-
-#define SLEEP_OFFLOAD_GETTIMEOFDAY 20
-
-/*
- * The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay.
- * This is used to limit the maximum lag between interp limit and script
- * cancellation checks.
- */
-
-#define TCL_TIME_MAXIMUM_SLICE 500
-
-/*
- * Prototypes for functions referenced only in this file:
- */
-
-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);
+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));
 
 /*
  *----------------------------------------------------------------------
@@ -180,10 +147,10 @@ static void		TimerSetupProc(ClientData clientData, int flags);
  */
 
 static ThreadSpecificData *
-InitTimer(void)
+InitTimer()
 {
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
-	    TclThreadDataKeyGet(&dataKey);
+    ThreadSpecificData *tsdPtr = 
+	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
 
     if (tsdPtr == NULL) {
 	tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -198,8 +165,8 @@ InitTimer(void)
  *
  * 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.
@@ -211,20 +178,19 @@ InitTimer(void)
  */
 
 static void
-TimerExitProc(
-    ClientData clientData)	/* Not used. */
+TimerExitProc(clientData)
+    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;
-	    ckfree(timerHandlerPtr);
+	    ckfree((char *) timerHandlerPtr);
 	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
 	}
     }
@@ -235,82 +201,55 @@ TimerExitProc(
  *
  * Tcl_CreateTimerHandler --
  *
- *	Arrange for a given function to be invoked at a particular time in the
- *	future.
+ *	Arrange for a given procedure 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(
-    int milliseconds,		/* How many milliseconds to wait before
-				 * invoking proc. */
-    Tcl_TimerProc *proc,	/* Function to invoke. */
-    ClientData clientData)	/* Arbitrary data to pass to proc. */
+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. */
 {
+    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);
-    time.sec += milliseconds/1000;
-    time.usec += (milliseconds%1000)*1000;
-    if (time.usec >= 1000000) {
-	time.usec -= 1000000;
-	time.sec += 1;
+    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;
     }
-    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 = ckalloc(sizeof(TimerHandler));
 
     /*
-     * Fill in fields for the event.
+     * Fill in other fields for the event.
      */
 
-    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
     timerHandlerPtr->proc = proc;
     timerHandlerPtr->clientData = clientData;
     tsdPtr->lastTimerId++;
-    timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);
+    timerHandlerPtr->token = (Tcl_TimerToken) tsdPtr->lastTimerId;
 
     /*
      * Add the event to the queue in the correct position
@@ -319,7 +258,9 @@ TclCreateAbsoluteTimerHandler(
 
     for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
 	    prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
-	if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) {
+	if ((tPtr2->time.sec > timerHandlerPtr->time.sec)
+		|| ((tPtr2->time.sec == timerHandlerPtr->time.sec)
+		&& (tPtr2->time.usec > timerHandlerPtr->time.usec))) {
 	    break;
 	}
     }
@@ -346,16 +287,17 @@ TclCreateAbsoluteTimerHandler(
  *	None.
  *
  * Side effects:
- *	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.
+ *	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.
  *
  *--------------------------------------------------------------
  */
 
 void
-Tcl_DeleteTimerHandler(
-    Tcl_TimerToken token)	/* Result previously returned by
+Tcl_DeleteTimerHandler(token)
+    Tcl_TimerToken token;	/* Result previously returned by
 				 * Tcl_DeleteTimerHandler. */
 {
     register TimerHandler *timerHandlerPtr, *prevPtr;
@@ -376,7 +318,7 @@ Tcl_DeleteTimerHandler(
 	} else {
 	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
 	}
-	ckfree(timerHandlerPtr);
+	ckfree((char *) timerHandlerPtr);
 	return;
     }
 }
@@ -386,9 +328,9 @@ Tcl_DeleteTimerHandler(
  *
  * 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.
@@ -400,9 +342,9 @@ Tcl_DeleteTimerHandler(
  */
 
 static void
-TimerSetupProc(
-    ClientData data,		/* Not used. */
-    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+TimerSetupProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
 {
     Tcl_Time blockTime;
     ThreadSpecificData *tsdPtr = InitTimer();
@@ -415,6 +357,7 @@ TimerSetupProc(
 
 	blockTime.sec = 0;
 	blockTime.usec = 0;
+
     } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
 	/*
 	 * Compute the timeout for the next timer on the list.
@@ -435,7 +378,7 @@ TimerSetupProc(
     } else {
 	return;
     }
-
+	
     Tcl_SetMaxBlockTime(&blockTime);
 }
 
@@ -444,9 +387,9 @@ TimerSetupProc(
  *
  * 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.
@@ -458,9 +401,9 @@ TimerSetupProc(
  */
 
 static void
-TimerCheckProc(
-    ClientData data,		/* Not used. */
-    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
+TimerCheckProc(data, flags)
+    ClientData data;		/* Not used. */
+    int flags;			/* Event flags as passed to Tcl_DoOneEvent. */
 {
     Tcl_Event *timerEvPtr;
     Tcl_Time blockTime;
@@ -491,7 +434,7 @@ TimerCheckProc(
 	if (blockTime.sec == 0 && blockTime.usec == 0 &&
 		!tsdPtr->timerPending) {
 	    tsdPtr->timerPending = 1;
-	    timerEvPtr = ckalloc(sizeof(Tcl_Event));
+	    timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
 	    timerEvPtr->proc = TimerHandlerEventProc;
 	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
 	}
@@ -503,27 +446,28 @@ TimerCheckProc(
  *
  * TimerHandlerEventProc --
  *
- *	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.
+ *	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.
  *
  * 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 functions do.
+ *	Whatever the timer handler callback procedures do.
  *
  *----------------------------------------------------------------------
  */
 
 static int
-TimerHandlerEventProc(
-    Tcl_Event *evPtr,		/* Event to service. */
-    int flags)			/* Flags that indicate what events to handle,
-				 * such as TCL_FILE_EVENTS. */
+TimerHandlerEventProc(evPtr, flags)
+    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;
@@ -531,9 +475,9 @@ TimerHandlerEventProc(
     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)) {
@@ -541,28 +485,30 @@ TimerHandlerEventProc(
     }
 
     /*
-     * 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;
@@ -574,8 +520,10 @@ TimerHandlerEventProc(
 	if (timerHandlerPtr == NULL) {
 	    break;
 	}
-
-	if (TCL_TIME_BEFORE(time, timerHandlerPtr->time)) {
+	    
+	if ((timerHandlerPtr->time.sec > time.sec)
+		|| ((timerHandlerPtr->time.sec == time.sec)
+			&& (timerHandlerPtr->time.usec > time.usec))) {
 	    break;
 	}
 
@@ -583,18 +531,18 @@ TimerHandlerEventProc(
 	 * Bail out if the next timer is of a newer generation.
 	 */
 
-	if ((currentTimerId - PTR2INT(timerHandlerPtr->token)) < 0) {
+	if ((currentTimerId - (int)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;
-	timerHandlerPtr->proc(timerHandlerPtr->clientData);
-	ckfree(timerHandlerPtr);
+	(*nextPtrPtr) = timerHandlerPtr->nextPtr;
+	(*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
+	ckfree((char *) timerHandlerPtr);
     }
     TimerSetupProc(NULL, TCL_TIMER_EVENTS);
     return 1;
@@ -605,30 +553,30 @@ TimerHandlerEventProc(
  *
  * 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(
-    Tcl_IdleProc *proc,		/* Function to invoke. */
-    ClientData clientData)	/* Arbitrary value to pass to proc. */
+Tcl_DoWhenIdle(proc, clientData)
+    Tcl_IdleProc *proc;		/* Procedure to invoke. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
 {
     register IdleHandler *idlePtr;
     Tcl_Time blockTime;
     ThreadSpecificData *tsdPtr = InitTimer();
 
-    idlePtr = ckalloc(sizeof(IdleHandler));
+    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
     idlePtr->proc = proc;
     idlePtr->clientData = clientData;
     idlePtr->generation = tsdPtr->idleGeneration;
@@ -650,23 +598,23 @@ Tcl_DoWhenIdle(
  *
  * Tcl_CancelIdleCall --
  *
- *	If there are any when-idle calls requested to a given function with
- *	given clientData, cancel all of them.
+ *	If there are any when-idle calls requested to a given procedure
+ *	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(
-    Tcl_IdleProc *proc,		/* Function that was previously registered. */
-    ClientData clientData)	/* Arbitrary value to pass to proc. */
+Tcl_CancelIdleCall(proc, clientData)
+    Tcl_IdleProc *proc;		/* Procedure that was previously registered. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
 {
     register IdleHandler *idlePtr, *prevPtr;
     IdleHandler *nextPtr;
@@ -677,7 +625,7 @@ Tcl_CancelIdleCall(
 	while ((idlePtr->proc == proc)
 		&& (idlePtr->clientData == clientData)) {
 	    nextPtr = idlePtr->nextPtr;
-	    ckfree(idlePtr);
+	    ckfree((char *) idlePtr);
 	    idlePtr = nextPtr;
 	    if (prevPtr == NULL) {
 		tsdPtr->idleList = idlePtr;
@@ -697,13 +645,14 @@ Tcl_CancelIdleCall(
  *
  * TclServiceIdle --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -712,7 +661,7 @@ Tcl_CancelIdleCall(
  */
 
 int
-TclServiceIdle(void)
+TclServiceIdle()
 {
     IdleHandler *idlePtr;
     int oldGeneration;
@@ -727,20 +676,22 @@ TclServiceIdle(void)
     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;
@@ -751,8 +702,8 @@ TclServiceIdle(void)
 	if (tsdPtr->idleList == NULL) {
 	    tsdPtr->lastIdlePtr = NULL;
 	}
-	idlePtr->proc(idlePtr->clientData);
-	ckfree(idlePtr);
+	(*idlePtr->proc)(idlePtr->clientData);
+	ckfree((char *) idlePtr);
     }
     if (tsdPtr->idleList) {
 	blockTime.sec = 0;
@@ -767,8 +718,8 @@ TclServiceIdle(void)
  *
  * Tcl_AfterObjCmd --
  *
- *	This function is invoked to process the "after" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "after" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -781,312 +732,203 @@ TclServiceIdle(void)
 
 	/* ARGSUSED */
 int
-Tcl_AfterObjCmd(
-    ClientData clientData,	/* Unused */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_WideInt ms = 0;		/* Number of milliseconds to wait */
-    Tcl_Time wakeup;
+    int ms;
     AfterInfo *afterPtr;
     AfterAssocData *assocPtr;
     int length;
+    char *argString;
     int index;
-    static const char *const afterSubCmds[] = {
-	"cancel", "idle", "info", NULL
+    char buf[16 + TCL_INTEGER_SPACE];
+    static CONST char *afterSubCmds[] = {
+	"cancel", "idle", "info", (char *) NULL
     };
     enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
     ThreadSpecificData *tsdPtr = InitTimer();
 
     if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
 	return TCL_ERROR;
     }
 
     /*
-     * 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 = ckalloc(sizeof(AfterAssocData));
+	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
 	assocPtr->interp = interp;
 	assocPtr->firstAfterPtr = NULL;
-	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
+	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
+		(ClientData) assocPtr);
     }
 
     /*
      * First lets see if the command was passed a number as the first argument.
      */
 
-    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) {
-            const char *arg = Tcl_GetString(objv[1]);
-
-	    Tcl_AppendResult(interp, "bad argument \"", arg,
-		    "\": must be cancel, idle, info, or an integer", NULL);
-            Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
-                    arg, NULL);
+    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) {
 	    return TCL_ERROR;
 	}
-    }
-
-    /*
-     * 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: {
+processInteger:
 	if (ms < 0) {
 	    ms = 0;
 	}
 	if (objc == 2) {
-	    return AfterDelay(interp, ms);
+	    Tcl_Sleep(ms);
+	    return TCL_OK;
 	}
-	afterPtr = ckalloc(sizeof(AfterInfo));
+	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);
+ 	    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;
-	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, afterPtr);
+	afterPtr->token = Tcl_CreateTimerHandler(ms, AfterProc,
+		(ClientData) afterPtr);
 	afterPtr->nextPtr = assocPtr->firstAfterPtr;
 	assocPtr->firstAfterPtr = afterPtr;
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
+	sprintf(buf, "after#%d", afterPtr->id);
+	Tcl_AppendResult(interp, buf, (char *) NULL);
 	return TCL_OK;
     }
-    case AFTER_CANCEL: {
-	Tcl_Obj *commandPtr;
-	const char *command, *tempCommand;
-	int tempLength;
 
-	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(command, tempCommand, (unsigned) length)) {
-		break;
+    /*
+     * 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 (afterPtr == NULL) {
-	    afterPtr = GetAfterEvent(assocPtr, commandPtr);
-	}
-	if (objc != 3) {
-	    Tcl_DecrRefCount(commandPtr);
-	}
-	if (afterPtr != NULL) {
-	    if (afterPtr->token != NULL) {
-		Tcl_DeleteTimerHandler(afterPtr->token);
+	    if (objc == 3) {
+		commandPtr = objv[2];
 	    } else {
-		Tcl_CancelIdleCall(AfterProc, afterPtr);
+		commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
 	    }
-	    FreeAfterPtr(afterPtr);
-	}
-	break;
-    }
-    case AFTER_IDLE:
-	if (objc < 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
-	    return TCL_ERROR;
-	}
-	afterPtr = ckalloc(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, afterPtr);
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
-	break;
-    case AFTER_INFO:
-	if (objc == 2) {
-            Tcl_Obj *resultObj = Tcl_NewObj();
-
-	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
+	    command = Tcl_GetStringFromObj(commandPtr, &length);
+	    for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
 		    afterPtr = afterPtr->nextPtr) {
-		if (assocPtr->interp == interp) {
-                    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
-                            "after#%d", afterPtr->id));
+		tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
+			&tempLength);
+		if ((length == tempLength)
+		        && (memcmp((void*) command, (void*) tempCommand,
+			        (unsigned) length) == 0)) {
+		    break;
 		}
 	    }
-            Tcl_SetObjResult(interp, resultObj);
-	    return TCL_OK;
-	}
-	if (objc != 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?id?");
-	    return TCL_ERROR;
-	}
-	afterPtr = GetAfterEvent(assocPtr, objv[2]);
-	if (afterPtr == NULL) {
-            const char *eventStr = TclGetString(objv[2]);
-
-	    Tcl_AppendResult(interp, "event \"", eventStr, "\" doesn't exist",
-                    NULL);
-            Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
-	    return TCL_ERROR;
-	} else {
-            Tcl_Obj *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 or being canceled).
- *
- * 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(&now);
-    endTime = now;
-    endTime.sec += (long)(ms/1000);
-    endTime.usec += ((int)(ms%1000))*1000;
-    if (endTime.usec >= 1000000) {
-	endTime.sec++;
-	endTime.usec -= 1000000;
-    }
-
-    do {
-	if (Tcl_AsyncReady()) {
-	    if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
-		return TCL_ERROR;
+	    if (afterPtr == NULL) {
+		afterPtr = GetAfterEvent(assocPtr, commandPtr);
 	    }
-	}
-	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
-	    return TCL_ERROR;
-	}
-	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;
+	    if (objc != 3) {
+		Tcl_DecrRefCount(commandPtr);
 	    }
-	}
-	if (iPtr->limit.timeEvent == NULL
-		|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
-	    diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
-#ifndef TCL_WIDE_INT_IS_LONG
-	    if (diff > LONG_MAX) {
-		diff = LONG_MAX;
-	    }
-#endif
-	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
-		diff = TCL_TIME_MAXIMUM_SLICE;
-	    }
-            if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1;
-	    if (diff > 0) {
-		Tcl_Sleep((long) diff);
-                if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break;
-	    } else break;
-	} else {
-	    diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
-#ifndef TCL_WIDE_INT_IS_LONG
-	    if (diff > LONG_MAX) {
-		diff = LONG_MAX;
+	    if (afterPtr != NULL) {
+		if (afterPtr->token != NULL) {
+		    Tcl_DeleteTimerHandler(afterPtr->token);
+		} else {
+		    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
+		}
+		FreeAfterPtr(afterPtr);
 	    }
-#endif
-	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
-		diff = TCL_TIME_MAXIMUM_SLICE;
+	    break;
+	}
+	case AFTER_IDLE:
+	    if (objc < 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
+		return TCL_ERROR;
 	    }
-	    if (diff > 0) {
-		Tcl_Sleep((long) diff);
+	    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 (Tcl_AsyncReady()) {
-		if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
-		    return TCL_ERROR;
+	    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;
 	    }
-	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "?id?");
 		return TCL_ERROR;
 	    }
-	    if (Tcl_LimitCheck(interp) != TCL_OK) {
+	    afterPtr = GetAfterEvent(assocPtr, objv[2]);
+	    if (afterPtr == NULL) {
+		Tcl_AppendResult(interp, "event \"", Tcl_GetString(objv[2]),
+			"\" doesn't exist", (char *) NULL);
 		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;
 	}
-        Tcl_GetTime(&now);
-    } while (TCL_TIME_BEFORE(now, endTime));
+	default: {
+	    panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
+	}
+    }
     return TCL_OK;
 }
 
@@ -1095,13 +937,13 @@ AfterDelay(
  *
  * GetAfterEvent --
  *
- *	This function parses an "after" id such as "after#4" and returns a
- *	pointer to the AfterInfo structure.
+ *	This procedure 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.
@@ -1110,18 +952,18 @@ AfterDelay(
  */
 
 static AfterInfo *
-GetAfterEvent(
-    AfterAssocData *assocPtr,	/* Points to "after"-related information for
+GetAfterEvent(assocPtr, commandPtr)
+    AfterAssocData *assocPtr;	/* Points to "after"-related information for
 				 * this interpreter. */
-    Tcl_Obj *commandPtr)
+    Tcl_Obj *commandPtr;
 {
-    const 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 = TclGetString(commandPtr);
+    cmdString = Tcl_GetString(commandPtr);
     if (strncmp(cmdString, "after#", 6) != 0) {
 	return NULL;
     }
@@ -1144,34 +986,37 @@ GetAfterEvent(
  *
  * 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)	/* Describes command to execute. */
+AfterProc(clientData)
+    ClientData clientData;	/* Describes command to execute. */
 {
-    AfterInfo *afterPtr = clientData;
+    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) {
@@ -1189,20 +1034,21 @@ AfterProc(
      */
 
     interp = assocPtr->interp;
-    Tcl_Preserve(interp);
-    result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
+    Tcl_Preserve((ClientData) interp);
+    script = Tcl_GetStringFromObj(afterPtr->commandPtr, &numBytes);
+    result = Tcl_EvalEx(interp, script, numBytes, TCL_EVAL_GLOBAL);
     if (result != TCL_OK) {
 	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
-	Tcl_BackgroundException(interp, result);
+	Tcl_BackgroundError(interp);
     }
-    Tcl_Release(interp);
-
+    Tcl_Release((ClientData) interp);
+    
     /*
      * Free the memory for the callback.
      */
 
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree(afterPtr);
+    ckfree((char *) afterPtr);
 }
 
 /*
@@ -1210,9 +1056,10 @@ AfterProc(
  *
  * FreeAfterPtr --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -1224,8 +1071,8 @@ AfterProc(
  */
 
 static void
-FreeAfterPtr(
-    AfterInfo *afterPtr)		/* Command to be deleted. */
+FreeAfterPtr(afterPtr)
+    AfterInfo *afterPtr;		/* Command to be deleted. */
 {
     AfterInfo *prevPtr;
     AfterAssocData *assocPtr = afterPtr->assocPtr;
@@ -1240,7 +1087,7 @@ FreeAfterPtr(
 	prevPtr->nextPtr = afterPtr->nextPtr;
     }
     Tcl_DecrRefCount(afterPtr->commandPtr);
-    ckfree(afterPtr);
+    ckfree((char *) afterPtr);
 }
 
 /*
@@ -1248,7 +1095,7 @@ FreeAfterPtr(
  *
  * AfterCleanupProc --
  *
- *	This function is invoked whenever an interpreter is deleted
+ *	This procedure is invoked whenever an interpreter is deleted
  *	to cleanup the AssocData for "tclAfter".
  *
  * Results:
@@ -1262,12 +1109,12 @@ FreeAfterPtr(
 
 	/* ARGSUSED */
 static void
-AfterCleanupProc(
-    ClientData clientData,	/* Points to AfterAssocData for the
+AfterCleanupProc(clientData, interp)
+    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 = clientData;
+    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
     AfterInfo *afterPtr;
 
     while (assocPtr->firstAfterPtr != NULL) {
@@ -1276,20 +1123,10 @@ AfterCleanupProc(
 	if (afterPtr->token != NULL) {
 	    Tcl_DeleteTimerHandler(afterPtr->token);
 	} else {
-	    Tcl_CancelIdleCall(AfterProc, afterPtr);
+	    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
 	}
 	Tcl_DecrRefCount(afterPtr->commandPtr);
-	ckfree(afterPtr);
+	ckfree((char *) afterPtr);
     }
-    ckfree(assocPtr);
+    ckfree((char *) assocPtr);
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * tab-width: 8
- * indent-tabs-mode: nil
- * End:
- */
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
deleted file mode 100644
index ea3abb1..0000000
--- a/generic/tclTomMath.decls
+++ /dev/null
@@ -1,223 +0,0 @@
-# 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}
-scspec EXTERN
-
-# Declare each of the functions in the Tcl tommath interface
-
-declare 0 {
-    int TclBN_epoch(void)
-}
-declare 1 {
-    int TclBN_revision(void)
-}
-
-declare 2 {
-    int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 3 {
-    int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
-}
-declare 4 {
-    int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 5 {
-    void TclBN_mp_clamp(mp_int *a)
-}
-declare 6 {
-    void TclBN_mp_clear(mp_int *a)
-}
-declare 7 {
-    void TclBN_mp_clear_multi(mp_int *a, ...)
-}
-declare 8 {
-    int TclBN_mp_cmp(const mp_int *a, const mp_int *b)
-}
-declare 9 {
-    int TclBN_mp_cmp_d(const mp_int *a, mp_digit b)
-}
-declare 10 {
-    int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b)
-}
-declare 11 {
-    int TclBN_mp_copy(const mp_int *a, mp_int *b)
-}
-declare 12 {
-    int TclBN_mp_count_bits(const mp_int *a)
-}
-declare 13 {
-    int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
-}
-declare 14 {
-    int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
-}
-declare 15 {
-    int TclBN_mp_div_2(mp_int *a, mp_int *q)
-}
-declare 16 {
-    int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r)
-}
-declare 17 {
-    int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
-}
-declare 18 {
-    void TclBN_mp_exch(mp_int *a, mp_int *b)
-}
-declare 19 {
-    int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
-}
-declare 20 {
-    int TclBN_mp_grow(mp_int *a, int size)
-}
-declare 21 {
-    int TclBN_mp_init(mp_int *a)
-}
-declare 22 {
-    int TclBN_mp_init_copy(mp_int *a, mp_int *b)
-}
-declare 23 {
-    int TclBN_mp_init_multi(mp_int *a, ...)
-}
-declare 24 {
-    int TclBN_mp_init_set(mp_int *a, mp_digit b)
-}
-declare 25 {
-    int TclBN_mp_init_size(mp_int *a, int size)
-}
-declare 26 {
-    int TclBN_mp_lshd(mp_int *a, int shift)
-}
-declare 27 {
-    int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
-}
-declare 28 {
-    int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r)
-}
-declare 29 {
-    int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
-}
-declare 30 {
-    int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
-}
-declare 31 {
-    int TclBN_mp_mul_2(mp_int *a, mp_int *p)
-}
-declare 32 {
-    int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p)
-}
-declare 33 {
-    int TclBN_mp_neg(const mp_int *a, mp_int *b)
-}
-declare 34 {
-    int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 35 {
-    int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
-}
-declare 36 {
-    int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
-}
-declare 37 {
-    void TclBN_mp_rshd(mp_int *a, int shift)
-}
-declare 38 {
-    int TclBN_mp_shrink(mp_int *a)
-}
-declare 39 {
-    void TclBN_mp_set(mp_int *a, mp_digit b)
-}
-declare 40 {
-    int TclBN_mp_sqr(mp_int *a, mp_int *b)
-}
-declare 41 {
-    int TclBN_mp_sqrt(mp_int *a, mp_int *b)
-}
-declare 42 {
-    int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 43 {
-    int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
-}
-declare 44 {
-    int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
-}
-declare 45 {
-    int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
-	    unsigned long *outlen)
-}
-declare 46 {
-    int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
-}
-declare 47 {
-    int TclBN_mp_unsigned_bin_size(mp_int *a)
-}
-declare 48 {
-    int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 49 {
-    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 {
-    void TclBN_reverse(unsigned char *s, int len)
-}
-declare 51 {
-    int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
-}
-declare 52 {
-    int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
-}
-declare 53 {
-    int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 54 {
-    int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
-}
-declare 55 {
-    int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 56 {
-    int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
-}
-declare 57 {
-    int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
-}
-declare 58 {
-    int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
-}
-declare 59 {
-    int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
-}
-declare 60 {
-    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(const mp_int *a)
-}
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
deleted file mode 100644
index dd9edaf..0000000
--- a/generic/tclTomMath.h
+++ /dev/null
@@ -1,832 +0,0 @@
-/* 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
-
-
-
-#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(const 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(const 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(const 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(const 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(const mp_int *a, mp_int *b);
-*/
-
-/* b = |a| */
-/*
-int mp_abs(mp_int *a, mp_int *b);
-*/
-
-/* compare a to b */
-/*
-int mp_cmp(const mp_int *a, const mp_int *b);
-*/
-
-/* compare |a| to |b| */
-/*
-int mp_cmp_mag(const mp_int *a, const 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(const 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(const 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
deleted file mode 100644
index 4f6c3bf..0000000
--- a/generic/tclTomMathDecls.h
+++ /dev/null
@@ -1,499 +0,0 @@
-/*
- *----------------------------------------------------------------------
- *
- * 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:
- */
-
-/* 0 */
-EXTERN int		TclBN_epoch(void);
-/* 1 */
-EXTERN int		TclBN_revision(void);
-/* 2 */
-EXTERN int		TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
-/* 3 */
-EXTERN int		TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
-/* 4 */
-EXTERN int		TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
-/* 5 */
-EXTERN void		TclBN_mp_clamp(mp_int *a);
-/* 6 */
-EXTERN void		TclBN_mp_clear(mp_int *a);
-/* 7 */
-EXTERN void		TclBN_mp_clear_multi(mp_int *a, ...);
-/* 8 */
-EXTERN int		TclBN_mp_cmp(const mp_int *a, const mp_int *b);
-/* 9 */
-EXTERN int		TclBN_mp_cmp_d(const mp_int *a, mp_digit b);
-/* 10 */
-EXTERN int		TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b);
-/* 11 */
-EXTERN int		TclBN_mp_copy(const mp_int *a, mp_int *b);
-/* 12 */
-EXTERN int		TclBN_mp_count_bits(const mp_int *a);
-/* 13 */
-EXTERN int		TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q,
-				mp_int *r);
-/* 14 */
-EXTERN int		TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
-				mp_digit *r);
-/* 15 */
-EXTERN int		TclBN_mp_div_2(mp_int *a, mp_int *q);
-/* 16 */
-EXTERN int		TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
-				mp_int *r);
-/* 17 */
-EXTERN int		TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
-/* 18 */
-EXTERN void		TclBN_mp_exch(mp_int *a, mp_int *b);
-/* 19 */
-EXTERN int		TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
-/* 20 */
-EXTERN int		TclBN_mp_grow(mp_int *a, int size);
-/* 21 */
-EXTERN int		TclBN_mp_init(mp_int *a);
-/* 22 */
-EXTERN int		TclBN_mp_init_copy(mp_int *a, mp_int *b);
-/* 23 */
-EXTERN int		TclBN_mp_init_multi(mp_int *a, ...);
-/* 24 */
-EXTERN int		TclBN_mp_init_set(mp_int *a, mp_digit b);
-/* 25 */
-EXTERN int		TclBN_mp_init_size(mp_int *a, int size);
-/* 26 */
-EXTERN int		TclBN_mp_lshd(mp_int *a, int shift);
-/* 27 */
-EXTERN int		TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
-/* 28 */
-EXTERN int		TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r);
-/* 29 */
-EXTERN int		TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p);
-/* 30 */
-EXTERN int		TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
-/* 31 */
-EXTERN int		TclBN_mp_mul_2(mp_int *a, mp_int *p);
-/* 32 */
-EXTERN int		TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
-/* 33 */
-EXTERN int		TclBN_mp_neg(const mp_int *a, mp_int *b);
-/* 34 */
-EXTERN int		TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
-/* 35 */
-EXTERN int		TclBN_mp_radix_size(mp_int *a, int radix, int *size);
-/* 36 */
-EXTERN int		TclBN_mp_read_radix(mp_int *a, const char *str,
-				int radix);
-/* 37 */
-EXTERN void		TclBN_mp_rshd(mp_int *a, int shift);
-/* 38 */
-EXTERN int		TclBN_mp_shrink(mp_int *a);
-/* 39 */
-EXTERN void		TclBN_mp_set(mp_int *a, mp_digit b);
-/* 40 */
-EXTERN int		TclBN_mp_sqr(mp_int *a, mp_int *b);
-/* 41 */
-EXTERN int		TclBN_mp_sqrt(mp_int *a, mp_int *b);
-/* 42 */
-EXTERN int		TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
-/* 43 */
-EXTERN int		TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
-/* 44 */
-EXTERN int		TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
-/* 45 */
-EXTERN int		TclBN_mp_to_unsigned_bin_n(mp_int *a,
-				unsigned char *b, unsigned long *outlen);
-/* 46 */
-EXTERN int		TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
-				int maxlen);
-/* 47 */
-EXTERN int		TclBN_mp_unsigned_bin_size(mp_int *a);
-/* 48 */
-EXTERN int		TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
-/* 49 */
-EXTERN void		TclBN_mp_zero(mp_int *a);
-/* 50 */
-EXTERN void		TclBN_reverse(unsigned char *s, int len);
-/* 51 */
-EXTERN int		TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
-				mp_int *c, int digs);
-/* 52 */
-EXTERN int		TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
-/* 53 */
-EXTERN int		TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
-				mp_int *c);
-/* 54 */
-EXTERN int		TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
-/* 55 */
-EXTERN int		TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
-/* 56 */
-EXTERN int		TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
-/* 57 */
-EXTERN int		TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
-/* 58 */
-EXTERN int		TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
-				int digs);
-/* 59 */
-EXTERN int		TclBN_s_mp_sqr(mp_int *a, mp_int *b);
-/* 60 */
-EXTERN int		TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
-/* 61 */
-EXTERN int		TclBN_mp_init_set_int(mp_int *a, unsigned long i);
-/* 62 */
-EXTERN int		TclBN_mp_set_int(mp_int *a, unsigned long i);
-/* 63 */
-EXTERN int		TclBN_mp_cnt_lsb(const mp_int *a);
-
-typedef struct TclTomMathStubs {
-    int magic;
-    const 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) (const mp_int *a, const mp_int *b); /* 8 */
-    int (*tclBN_mp_cmp_d) (const mp_int *a, mp_digit b); /* 9 */
-    int (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b); /* 10 */
-    int (*tclBN_mp_copy) (const mp_int *a, mp_int *b); /* 11 */
-    int (*tclBN_mp_count_bits) (const 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) (const 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) (const 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) (const mp_int *a, int d, mp_int *p); /* 32 */
-    int (*tclBN_mp_neg) (const 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) (const mp_int *a); /* 63 */
-} TclTomMathStubs;
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-extern const TclTomMathStubs *tclTomMathStubsPtr;
-#ifdef __cplusplus
-}
-#endif
-
-#if defined(USE_TCL_STUBS)
-
-/*
- * Inline function declarations:
- */
-
-#define TclBN_epoch \
-	(tclTomMathStubsPtr->tclBN_epoch) /* 0 */
-#define TclBN_revision \
-	(tclTomMathStubsPtr->tclBN_revision) /* 1 */
-#define TclBN_mp_add \
-	(tclTomMathStubsPtr->tclBN_mp_add) /* 2 */
-#define TclBN_mp_add_d \
-	(tclTomMathStubsPtr->tclBN_mp_add_d) /* 3 */
-#define TclBN_mp_and \
-	(tclTomMathStubsPtr->tclBN_mp_and) /* 4 */
-#define TclBN_mp_clamp \
-	(tclTomMathStubsPtr->tclBN_mp_clamp) /* 5 */
-#define TclBN_mp_clear \
-	(tclTomMathStubsPtr->tclBN_mp_clear) /* 6 */
-#define TclBN_mp_clear_multi \
-	(tclTomMathStubsPtr->tclBN_mp_clear_multi) /* 7 */
-#define TclBN_mp_cmp \
-	(tclTomMathStubsPtr->tclBN_mp_cmp) /* 8 */
-#define TclBN_mp_cmp_d \
-	(tclTomMathStubsPtr->tclBN_mp_cmp_d) /* 9 */
-#define TclBN_mp_cmp_mag \
-	(tclTomMathStubsPtr->tclBN_mp_cmp_mag) /* 10 */
-#define TclBN_mp_copy \
-	(tclTomMathStubsPtr->tclBN_mp_copy) /* 11 */
-#define TclBN_mp_count_bits \
-	(tclTomMathStubsPtr->tclBN_mp_count_bits) /* 12 */
-#define TclBN_mp_div \
-	(tclTomMathStubsPtr->tclBN_mp_div) /* 13 */
-#define TclBN_mp_div_d \
-	(tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */
-#define TclBN_mp_div_2 \
-	(tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */
-#define TclBN_mp_div_2d \
-	(tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */
-#define TclBN_mp_div_3 \
-	(tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */
-#define TclBN_mp_exch \
-	(tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */
-#define TclBN_mp_expt_d \
-	(tclTomMathStubsPtr->tclBN_mp_expt_d) /* 19 */
-#define TclBN_mp_grow \
-	(tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */
-#define TclBN_mp_init \
-	(tclTomMathStubsPtr->tclBN_mp_init) /* 21 */
-#define TclBN_mp_init_copy \
-	(tclTomMathStubsPtr->tclBN_mp_init_copy) /* 22 */
-#define TclBN_mp_init_multi \
-	(tclTomMathStubsPtr->tclBN_mp_init_multi) /* 23 */
-#define TclBN_mp_init_set \
-	(tclTomMathStubsPtr->tclBN_mp_init_set) /* 24 */
-#define TclBN_mp_init_size \
-	(tclTomMathStubsPtr->tclBN_mp_init_size) /* 25 */
-#define TclBN_mp_lshd \
-	(tclTomMathStubsPtr->tclBN_mp_lshd) /* 26 */
-#define TclBN_mp_mod \
-	(tclTomMathStubsPtr->tclBN_mp_mod) /* 27 */
-#define TclBN_mp_mod_2d \
-	(tclTomMathStubsPtr->tclBN_mp_mod_2d) /* 28 */
-#define TclBN_mp_mul \
-	(tclTomMathStubsPtr->tclBN_mp_mul) /* 29 */
-#define TclBN_mp_mul_d \
-	(tclTomMathStubsPtr->tclBN_mp_mul_d) /* 30 */
-#define TclBN_mp_mul_2 \
-	(tclTomMathStubsPtr->tclBN_mp_mul_2) /* 31 */
-#define TclBN_mp_mul_2d \
-	(tclTomMathStubsPtr->tclBN_mp_mul_2d) /* 32 */
-#define TclBN_mp_neg \
-	(tclTomMathStubsPtr->tclBN_mp_neg) /* 33 */
-#define TclBN_mp_or \
-	(tclTomMathStubsPtr->tclBN_mp_or) /* 34 */
-#define TclBN_mp_radix_size \
-	(tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */
-#define TclBN_mp_read_radix \
-	(tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */
-#define TclBN_mp_rshd \
-	(tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */
-#define TclBN_mp_shrink \
-	(tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */
-#define TclBN_mp_set \
-	(tclTomMathStubsPtr->tclBN_mp_set) /* 39 */
-#define TclBN_mp_sqr \
-	(tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */
-#define TclBN_mp_sqrt \
-	(tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */
-#define TclBN_mp_sub \
-	(tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */
-#define TclBN_mp_sub_d \
-	(tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */
-#define TclBN_mp_to_unsigned_bin \
-	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */
-#define TclBN_mp_to_unsigned_bin_n \
-	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */
-#define TclBN_mp_toradix_n \
-	(tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */
-#define TclBN_mp_unsigned_bin_size \
-	(tclTomMathStubsPtr->tclBN_mp_unsigned_bin_size) /* 47 */
-#define TclBN_mp_xor \
-	(tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */
-#define TclBN_mp_zero \
-	(tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */
-#define TclBN_reverse \
-	(tclTomMathStubsPtr->tclBN_reverse) /* 50 */
-#define TclBN_fast_s_mp_mul_digs \
-	(tclTomMathStubsPtr->tclBN_fast_s_mp_mul_digs) /* 51 */
-#define TclBN_fast_s_mp_sqr \
-	(tclTomMathStubsPtr->tclBN_fast_s_mp_sqr) /* 52 */
-#define TclBN_mp_karatsuba_mul \
-	(tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */
-#define TclBN_mp_karatsuba_sqr \
-	(tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */
-#define TclBN_mp_toom_mul \
-	(tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */
-#define TclBN_mp_toom_sqr \
-	(tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */
-#define TclBN_s_mp_add \
-	(tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */
-#define TclBN_s_mp_mul_digs \
-	(tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */
-#define TclBN_s_mp_sqr \
-	(tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */
-#define TclBN_s_mp_sub \
-	(tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */
-#define TclBN_mp_init_set_int \
-	(tclTomMathStubsPtr->tclBN_mp_init_set_int) /* 61 */
-#define TclBN_mp_set_int \
-	(tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */
-#define TclBN_mp_cnt_lsb \
-	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
-
-#endif /* defined(USE_TCL_STUBS) */
-
-/* !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
deleted file mode 100644
index 831f13f..0000000
--- a/generic/tclTomMathInt.h
+++ /dev/null
@@ -1,3 +0,0 @@
-#include "tclInt.h"
-#include "tclTomMath.h"
-#include "tommath_class.h"
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
deleted file mode 100644
index 775e86b..0000000
--- a/generic/tclTomMathInterface.c
+++ /dev/null
@@ -1,310 +0,0 @@
-/*
- *----------------------------------------------------------------------
- *
- * 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"
-
-MODULE_SCOPE const 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,
-	    &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 *) Tcl_Alloc((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 *) Tcl_Realloc((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)
-{
-    Tcl_Free((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/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c
deleted file mode 100644
index e7e4aea..0000000
--- a/generic/tclTomMathStubLib.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/*
- * tclTomMathStubLib.c --
- *
- *	Stub object that will be statically linked into extensions that want
- *	to access Tcl.
- *
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 1998 Paul Duffin.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-/*
- * We need to ensure that we use the stub macros so that this file contains no
- * references to any of the stub functions. This will make it possible to
- * build an extension that references Tcl_InitStubs but doesn't end up
- * including the rest of the stub functions.
- */
-
-#define USE_TCL_STUBS
-
-#include "tclInt.h"
-
-MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;
-
-const TclTomMathStubs *tclTomMathStubsPtr = NULL;
-
-
-/*
- *----------------------------------------------------------------------
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-MODULE_SCOPE 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 =
-	Tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
-    const TclTomMathStubs *stubsPtr = 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;
-    }
-    Tcl_ResetResult(interp);
-    Tcl_AppendResult(interp, "error loading ", packageName,
-	    " (requested version ", version, ", actual version ",
-	    actualVersion, "): ", errMsg, NULL);
-    return NULL;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
deleted file mode 100644
index 25abdff..0000000
--- a/generic/tclTrace.c
+++ /dev/null
@@ -1,3256 +0,0 @@
-/*
- * 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[1];		/* 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 1
-				 * byte. */
-} 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[1];		/* 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 1
-				 * byte. */
-} 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 *const 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;
-
-/*
- * Convenience macros for iterating over the list of traces. Note that each of
- * these *must* be treated as a command, and *must* have a block following it.
- */
-
-#define FOREACH_VAR_TRACE(interp, name, clientData) \
-    (clientData) = NULL; \
-    while (((clientData) = Tcl_VarTraceInfo((interp), (name), 0, \
-	    TraceVarProc, (clientData))) != NULL)
-
-#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
-    (clientData) = NULL; \
-    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
-	    TraceCommandProc, clientData)) != NULL)
-
-/*
- *----------------------------------------------------------------------
- *
- * 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;
-    const char *name;
-    const char *flagOps, *p;
-    /* Main sub commands to 'trace' */
-    static const char *const 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 ...?");
-	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 ...?");
-	    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();
-	name = Tcl_GetString(objv[2]);
-	FOREACH_VAR_TRACE(interp, name, clientData) {
-	    TraceVarInfo *tvarPtr = clientData;
-	    char *q = ops;
-
-	    pairObjPtr = Tcl_NewListObj(0, NULL);
-	    if (tvarPtr->flags & TCL_TRACE_READS) {
-		*q = 'r';
-		q++;
-	    }
-	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
-		*q = 'w';
-		q++;
-	    }
-	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
-		*q = 'u';
-		q++;
-	    }
-	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
-		*q = 'a';
-		q++;
-	    }
-	    *q = '\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);
-    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", 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;
-    const char *name, *command;
-    size_t length;
-    enum traceOptions {
-	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
-    };
-    static const char *const 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);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
-		    NULL);
-	    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 = ckalloc(
-		    TclOffset(TraceCommandInfo, command) + 1 + length);
-
-	    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,
-		    tcmdPtr) != TCL_OK) {
-		ckfree(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.
-	     */
-
-	    ClientData clientData;
-
-	    /*
-	     * First ensure the name given is valid.
-	     */
-
-	    name = Tcl_GetString(objv[3]);
-	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
-		return TCL_ERROR;
-	    }
-
-	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
-		TraceCommandInfo *tcmdPtr = 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(tcmdPtr->startCmd);
-			}
-		    }
-		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
-			/*
-			 * Postpone deletion.
-			 */
-
-			tcmdPtr->flags = 0;
-		    }
-		    if ((--tcmdPtr->refCount) <= 0) {
-			ckfree(tcmdPtr);
-		    }
-		    break;
-		}
-	    }
-	}
-	break;
-    }
-    case TRACE_INFO: {
-	ClientData clientData;
-	Tcl_Obj *resultListPtr;
-
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 3, objv, "name");
-	    return TCL_ERROR;
-	}
-
-	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);
-	FOREACH_COMMAND_TRACE(interp, name, clientData) {
-	    int numOps = 0;
-	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
-	    TraceCommandInfo *tcmdPtr = 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;
-    const char *name, *command;
-    size_t length;
-    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
-    static const char *const 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);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
-		    NULL);
-	    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 = ckalloc(
-		    TclOffset(TraceCommandInfo, command) + 1 + length);
-
-	    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,
-		    tcmdPtr) != TCL_OK) {
-		ckfree(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.
-	     */
-
-	    ClientData clientData;
-
-	    /*
-	     * First ensure the name given is valid.
-	     */
-
-	    name = Tcl_GetString(objv[3]);
-	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
-		return TCL_ERROR;
-	    }
-
-	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
-		TraceCommandInfo *tcmdPtr = 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(tcmdPtr);
-		    }
-		    break;
-		}
-	    }
-	}
-	break;
-    }
-    case TRACE_INFO: {
-	ClientData clientData;
-	Tcl_Obj *resultListPtr;
-
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 3, objv, "name");
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * First ensure the name given is valid.
-	 */
-
-	name = Tcl_GetString(objv[3]);
-	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
-	    return TCL_ERROR;
-	}
-
-	resultListPtr = Tcl_NewListObj(0, NULL);
-	FOREACH_COMMAND_TRACE(interp, name, clientData) {
-	    int numOps = 0;
-	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
-	    TraceCommandInfo *tcmdPtr = 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;
-    const char *name, *command;
-    size_t length;
-    ClientData clientData;
-    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
-    static const char *const 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);
-	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
-		    NULL);
-	    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 = ckalloc(
-		    TclOffset(CombinedTraceVarInfo, traceCmdInfo.command)
-		    + 1 + length);
-
-	    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 = &ctvarPtr->traceCmdInfo;
-	    ctvarPtr->traceInfo.flags = flags;
-	    name = Tcl_GetString(objv[3]);
-	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
-		    != TCL_OK) {
-		ckfree(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.
-	     */
-
-	    name = Tcl_GetString(objv[3]);
-	    FOREACH_VAR_TRACE(interp, name, clientData) {
-		TraceVarInfo *tvarPtr = 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: {
-	Tcl_Obj *resultListPtr;
-
-	if (objc != 4) {
-	    Tcl_WrongNumArgs(interp, 3, objv, "name");
-	    return TCL_ERROR;
-	}
-
-	resultListPtr = Tcl_NewObj();
-	name = Tcl_GetString(objv[3]);
-	FOREACH_VAR_TRACE(interp, name, clientData) {
-	    Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
-	    TraceVarInfo *tvarPtr = 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(opObjPtr, "array");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
-	    }
-	    if (tvarPtr->flags & TCL_TRACE_READS) {
-		TclNewLiteralStringObj(opObjPtr, "read");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
-	    }
-	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
-		TclNewLiteralStringObj(opObjPtr, "write");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
-	    }
-	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
-		TclNewLiteralStringObj(opObjPtr, "unset");
-		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
-	    }
-	    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 = 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(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 = 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(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);
-	Tcl_RestoreInterpState(interp, state);
-	tcmdPtr->refCount--;
-    }
-    if ((--tcmdPtr->refCount) <= 0) {
-	ckfree(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 = 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(tcmdPtr, interp, curLevel,
-			command, (Tcl_Command) cmdPtr, objc, objv);
-		if ((--tcmdPtr->refCount) <= 0) {
-		    ckfree(tcmdPtr);
-		}
-	    }
-	}
-	if (active.nextTracePtr) {
-	    lastTracePtr = active.nextTracePtr->nextPtr;
-	}
-    }
-    iPtr->activeCmdTracePtr = active.nextPtr;
-    if (state) {
-	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(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 = 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(tracePtr);
-	}
-    }
-    iPtr->activeInterpTracePtr = active.nextPtr;
-    if (state) {
-	if (traceCode == TCL_OK) {
-	    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 = clientData;
-
-    if ((--tcmdPtr->refCount) <= 0) {
-	ckfree(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 = 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(tcmdPtr->startCmd);
-	    }
-	}
-
-	/*
-	 * Second, create the tcl callback, if required.
-	 */
-
-	if (call) {
-	    Tcl_DString cmd, 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;
-		const 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, 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(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 = clientData;
-    char *result;
-    int code, destroy = 0;
-    Tcl_DString cmd;
-    int rewind = ((Interp *)interp)->execEnvPtr->rewind;
-
-    /*
-     * 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;
-	    }
-
-	    /*
-	     * Make sure that unset traces are rune even if the execEnv is
-	     * rewinding (coroutine deletion, [Bug 2093947]
-	     */
-
-	    if (rewind && (flags & TCL_TRACE_UNSETS)) {
-		((Interp *)interp)->execEnvPtr->rewind = 0;
-	    }
-	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
-		    Tcl_DStringLength(&cmd), 0);
-	    if (rewind) {
-		((Interp *)interp)->execEnvPtr->rewind = rewind;
-	    }
-	    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 = 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 = ckalloc(sizeof(StringTraceData));
-
-    data->clientData = clientData;
-    data->proc = proc;
-    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
-	    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 = 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(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 = &prevPtr->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, *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. */
-{
-    const 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(iPtr);
-    if (arrayPtr && !TclIsVarTraceActive(arrayPtr)
-	    && (arrayPtr->flags & traceflags)) {
-	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr);
-	active.varPtr = arrayPtr;
-	for (tracePtr = Tcl_GetHashValue(hPtr);
-		tracePtr != NULL; tracePtr = active.nextTracePtr) {
-	    active.nextTracePtr = tracePtr->nextPtr;
-	    if (!(tracePtr->flags & flags)) {
-		continue;
-	    }
-	    Tcl_Preserve(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(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 = Tcl_GetHashValue(hPtr);
-		tracePtr != NULL; tracePtr = active.nextTracePtr) {
-	    active.nextTracePtr = tracePtr->nextPtr;
-	    if (!(tracePtr->flags & flags)) {
-		continue;
-	    }
-	    Tcl_Preserve(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(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 {
-	    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(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 = 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(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;
-    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) {
-	register VarTrace *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 = ckalloc(sizeof(VarTrace));
-    tracePtr->traceProc = proc;
-    tracePtr->clientData = clientData;
-    tracePtr->flags = flags;
-
-    result = TraceVarEx(interp, part1, part2, tracePtr);
-
-    if (result != TCL_OK) {
-	ckfree(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, varPtr, &isNew);
-    if (isNew) {
-	tracePtr->nextPtr = NULL;
-    } else {
-	tracePtr->nextPtr = Tcl_GetHashValue(hPtr);
-    }
-    Tcl_SetHashValue(hPtr, 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 2fabe58..5218f48 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 f0d08e7..b6da7c3 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,48 +18,48 @@
 #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] = {
+static CONST unsigned char totalBytes[256] = {
     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,
     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,
     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,
@@ -86,10 +86,11 @@ static const unsigned char totalBytes[256] = {
 };
 
 /*
- * Functions used only in this module.
+ * Procedures used only in this module.
  */
 
-static int		UtfCount(int ch);
+static int UtfCount _ANSI_ARGS_((int ch));
+
 
 /*
  *---------------------------------------------------------------------------
@@ -108,8 +109,8 @@ static int		UtfCount(int ch);
  */
 
 INLINE static int
-UtfCount(
-    int ch)			/* The Tcl_UniChar whose size is returned. */
+UtfCount(ch)
+    int ch;			/* The Tcl_UniChar whose size is returned. */
 {
     if ((ch > 0) && (ch < UNICODE_SELF)) {
 	return 1;
@@ -140,11 +141,11 @@ UtfCount(
  * 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.
@@ -153,55 +154,55 @@ UtfCount(
  */
 
 INLINE int
-Tcl_UniCharToUtf(
-    int ch,			/* The Tcl_UniChar to be stored in the
+Tcl_UniCharToUtf(ch, str)
+    int ch;			/* The Tcl_UniChar to be stored in the
 				 * buffer. */
-    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
+    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
 				 * (at most TCL_UTF_MAX bytes). */
 {
     if ((ch > 0) && (ch < UNICODE_SELF)) {
-	buf[0] = (char) ch;
+	str[0] = (char) ch;
 	return 1;
     }
     if (ch >= 0) {
 	if (ch <= 0x7FF) {
-	    buf[1] = (char) ((ch | 0x80) & 0xBF);
-	    buf[0] = (char) ((ch >> 6) | 0xC0);
+	    str[1] = (char) ((ch | 0x80) & 0xBF);
+	    str[0] = (char) ((ch >> 6) | 0xC0);
 	    return 2;
 	}
 	if (ch <= 0xFFFF) {
 	three:
-	    buf[2] = (char) ((ch | 0x80) & 0xBF);
-	    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
-	    buf[0] = (char) ((ch >> 12) | 0xE0);
+	    str[2] = (char) ((ch | 0x80) & 0xBF);
+	    str[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
+	    str[0] = (char) ((ch >> 12) | 0xE0);
 	    return 3;
 	}
 
 #if TCL_UTF_MAX > 3
 	if (ch <= 0x1FFFFF) {
-	    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);
+	    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);
 	    return 4;
 	}
 	if (ch <= 0x3FFFFFF) {
-	    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);
+	    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);
 	    return 5;
 	}
 	if (ch <= 0x7FFFFFFF) {
-	    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);
+	    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);
 	    return 6;
 	}
 #endif
@@ -220,8 +221,8 @@ Tcl_UniCharToUtf(
  *
  * 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.
@@ -230,14 +231,15 @@ Tcl_UniCharToUtf(
  */
 
 char *
-Tcl_UniCharToUtfDString(
-    const Tcl_UniChar *uniStr,	/* Unicode string to convert to UTF-8. */
-    int uniLength,		/* Length of Unicode string in Tcl_UniChars
+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
 				 * (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;
+    CONST Tcl_UniChar *w, *wEnd;
     char *p, *string;
     int oldLength;
 
@@ -247,12 +249,12 @@ Tcl_UniCharToUtfDString(
      */
 
     oldLength = Tcl_DStringLength(dsPtr);
-    Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX);
+    Tcl_DStringSetLength(dsPtr, (oldLength + numChars + 1) * TCL_UTF_MAX);
     string = Tcl_DStringValue(dsPtr) + oldLength;
 
     p = string;
-    wEnd = uniStr + uniLength;
-    for (w = uniStr; w < wEnd; ) {
+    wEnd = wString + numChars;
+    for (w = wString; w < wEnd; ) {
 	p += Tcl_UniCharToUtf(*w, p);
 	w++;
     }
@@ -266,16 +268,16 @@ Tcl_UniCharToUtfDString(
  *
  * 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
@@ -288,10 +290,10 @@ Tcl_UniCharToUtfDString(
  */
 
 int
-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. */
+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. */
 {
     register int byte;
 
@@ -299,7 +301,7 @@ Tcl_UtfToUniChar(
      * Unroll 1 to 3 byte UTF-8 sequences, use loop to handle longer ones.
      */
 
-    byte = *((unsigned char *) src);
+    byte = *((unsigned char *) str);
     if (byte < 0xC0) {
 	/*
 	 * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
@@ -310,15 +312,14 @@ Tcl_UtfToUniChar(
 	*chPtr = (Tcl_UniChar) byte;
 	return 1;
     } else if (byte < 0xE0) {
-	if ((src[1] & 0xC0) == 0x80) {
+	if ((str[1] & 0xC0) == 0x80) {
 	    /*
 	     * Two-byte-character lead-byte followed by a trail-byte.
 	     */
 
-	    *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F));
+	    *chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (str[1] & 0x3F));
 	    return 2;
 	}
-
 	/*
 	 * A two-byte-character lead-byte not followed by trail-byte
 	 * represents itself.
@@ -327,16 +328,15 @@ Tcl_UtfToUniChar(
 	*chPtr = (Tcl_UniChar) byte;
 	return 1;
     } else if (byte < 0xF0) {
-	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
+	if (((str[1] & 0xC0) == 0x80) && ((str[2] & 0xC0) == 0x80)) {
 	    /*
 	     * Three-byte-character lead byte followed by two trail bytes.
 	     */
 
 	    *chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
-		    | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
+		    | ((str[1] & 0x3F) << 6) | (str[2] & 0x3F));
 	    return 3;
 	}
-
 	/*
 	 * A three-byte-character lead-byte not followed by two trail-bytes
 	 * represents itself.
@@ -346,7 +346,7 @@ Tcl_UtfToUniChar(
 	return 1;
     }
 #if TCL_UTF_MAX > 3
-    {
+    else {
 	int ch, total, trail;
 
 	total = totalBytes[byte];
@@ -354,13 +354,13 @@ Tcl_UtfToUniChar(
 	if (trail > 0) {
 	    ch = byte & (0x3F >> trail);
 	    do {
-		src++;
-		if ((*src & 0xC0) != 0x80) {
+		str++;
+		if ((*str & 0xC0) != 0x80) {
 		    *chPtr = byte;
 		    return 1;
 		}
 		ch <<= 6;
-		ch |= (*src & 0x3F);
+		ch |= (*str & 0x3F);
 		trail--;
 	    } while (trail > 0);
 	    *chPtr = ch;
@@ -382,8 +382,9 @@ Tcl_UtfToUniChar(
  *
  * 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.
@@ -392,36 +393,35 @@ Tcl_UtfToUniChar(
  */
 
 Tcl_UniChar *
-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
+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
 				 * appended to this previously initialized
 				 * DString. */
 {
     Tcl_UniChar *w, *wString;
-    const char *p, *end;
+    CONST char *p, *end;
     int oldLength;
 
     if (length < 0) {
-	length = strlen(src);
+	length = strlen(string);
     }
 
     /*
-     * 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);
-/* TODO: fix overreach! */
     Tcl_DStringSetLength(dsPtr,
 	    (int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
     wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
 
     w = wString;
-    end = src + length;
-    for (p = src; p < end; ) {
+    end = string + length;
+    for (p = string; p < end; ) {
 	p += TclUtfToUniChar(p, w);
 	w++;
     }
@@ -437,9 +437,9 @@ Tcl_UtfToUniCharDString(
  *
  * 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 +452,15 @@ Tcl_UtfToUniCharDString(
  */
 
 int
-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. */
+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. */
 {
     int ch;
 
-    ch = *((unsigned char *) src);
-    return length >= totalBytes[ch];
+    ch = *((unsigned char *) str);
+    return len >= totalBytes[ch];
 }
 
 /*
@@ -468,9 +468,9 @@ Tcl_UtfCharComplete(
  *
  * 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 +482,9 @@ Tcl_UtfCharComplete(
  */
 
 int
-Tcl_NumUtfChars(
-    register const char *src,	/* The UTF-8 string to measure. */
-    int length)			/* The length of the string in bytes, or -1
+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
 				 * for strlen(string). */
 {
     Tcl_UniChar ch;
@@ -494,27 +494,27 @@ Tcl_NumUtfChars(
     /*
      * 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 (length < 0) {
-	while (*src != '\0') {
-	    src += TclUtfToUniChar(src, chPtr);
+    if (len < 0) {
+	while (*str != '\0') {
+	    str += TclUtfToUniChar(str, chPtr);
 	    i++;
 	}
     } else {
 	register int n;
 
-	while (length > 0) {
-	    if (UCHAR(*src) < 0xC0) {
-		length--;
-		src++;
+	while (len > 0) {
+	    if (UCHAR(*str) < 0xC0) {
+		len--;
+		str++;
 	    } else {
-		n = Tcl_UtfToUniChar(src, chPtr);
-		length -= n;
-		src += n;
+		n = Tcl_UtfToUniChar(str, chPtr);
+		len -= n;
+		str += n;
 	    }
 	    i++;
 	}
@@ -527,37 +527,37 @@ Tcl_NumUtfChars(
  *
  * 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(
-    const char *src,		/* The UTF-8 string to be searched. */
-    int ch)			/* The Tcl_UniChar to search for. */
+CONST char *
+Tcl_UtfFindFirst(string, ch)
+    CONST char *string;		/* The UTF-8 string to be searched. */
+    int ch;			/* The Tcl_UniChar to search for. */
 {
     int len;
     Tcl_UniChar find;
 
     while (1) {
-	len = TclUtfToUniChar(src, &find);
+	len = TclUtfToUniChar(string, &find);
 	if (find == ch) {
-	    return src;
+	    return string;
 	}
-	if (*src == '\0') {
+	if (*string == '\0') {
 	    return NULL;
 	}
-	src += len;
+	string += len;
     }
 }
 
@@ -566,13 +566,14 @@ Tcl_UtfFindFirst(
  *
  * 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.
@@ -580,25 +581,25 @@ Tcl_UtfFindFirst(
  *---------------------------------------------------------------------------
  */
 
-const char *
-Tcl_UtfFindLast(
-    const char *src,		/* The UTF-8 string to be searched. */
-    int ch)			/* The Tcl_UniChar to search for. */
+CONST char *
+Tcl_UtfFindLast(string, ch)
+    CONST char *string;		/* The UTF-8 string to be searched. */
+    int ch;			/* The Tcl_UniChar to search for. */
 {
     int len;
     Tcl_UniChar find;
-    const char *last;
+    CONST char *last;
 
     last = NULL;
     while (1) {
-	len = TclUtfToUniChar(src, &find);
+	len = TclUtfToUniChar(string, &find);
 	if (find == ch) {
-	    last = src;
+	    last = string;
 	}
-	if (*src == '\0') {
+	if (*string == '\0') {
 	    break;
 	}
-	src += len;
+	string += len;
     }
     return last;
 }
@@ -608,13 +609,14 @@ Tcl_UtfFindLast(
  *
  * 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.
@@ -622,13 +624,13 @@ Tcl_UtfFindLast(
  *---------------------------------------------------------------------------
  */
 
-const char *
-Tcl_UtfNext(
-    const char *src)		/* The current location in the string. */
+CONST char *
+Tcl_UtfNext(str)
+    CONST char *str;		    /* The current location in the string. */
 {
     Tcl_UniChar ch;
 
-    return src + TclUtfToUniChar(src, &ch);
+    return str + TclUtfToUniChar(str, &ch);
 }
 
 /*
@@ -636,15 +638,15 @@ Tcl_UtfNext(
  *
  * 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.
@@ -652,21 +654,22 @@ Tcl_UtfNext(
  *---------------------------------------------------------------------------
  */
 
-const char *
-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 *
+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. */
 {
-    const char *look;
+    CONST char *look;
     int i, byte;
 
-    src--;
-    look = src;
+    str--;
+    look = str;
     for (i = 0; i < TCL_UTF_MAX; i++) {
 	if (look < start) {
-	    if (src < start) {
-		src = start;
+	    if (str < start) {
+		str = start;
 	    }
 	    break;
 	}
@@ -679,7 +682,7 @@ Tcl_UtfPrev(
 	}
 	look--;
     }
-    return src;
+    return str;
 }
 
 /*
@@ -687,8 +690,8 @@ Tcl_UtfPrev(
  *
  * 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.
@@ -700,11 +703,11 @@ Tcl_UtfPrev(
  */
 
 Tcl_UniChar
-Tcl_UniCharAtIndex(
-    register const char *src,	/* The UTF-8 string to dereference. */
-    register int index)		/* The position of the desired character. */
+Tcl_UniCharAtIndex(src, index)
+    register CONST char *src;	/* The UTF-8 string to dereference. */
+    register int index;		/* The position of the desired character. */
 {
-    Tcl_UniChar ch = 0;
+    Tcl_UniChar ch;
 
     while (index >= 0) {
 	index--;
@@ -718,8 +721,8 @@ Tcl_UniCharAtIndex(
  *
  * 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.
@@ -730,10 +733,10 @@ Tcl_UniCharAtIndex(
  *---------------------------------------------------------------------------
  */
 
-const char *
-Tcl_UtfAtIndex(
-    register const char *src,	/* The UTF-8 string. */
-    register int index)		/* The position of the desired character. */
+CONST char *
+Tcl_UtfAtIndex(src, index)
+    register CONST char *src;	/* The UTF-8 string. */
+    register int index;		/* The position of the desired character. */
 {
     Tcl_UniChar ch;
 
@@ -753,30 +756,31 @@ Tcl_UtfAtIndex(
  *
  * 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(
-    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(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
 				 * backslash sequence. */
 {
 #define LINE_LENGTH 128
@@ -785,10 +789,7 @@ Tcl_UtfBackslash(
 
     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) {
@@ -802,12 +803,12 @@ Tcl_UtfBackslash(
  *
  * 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.
@@ -816,8 +817,8 @@ Tcl_UtfBackslash(
  */
 
 int
-Tcl_UtfToUpper(
-    char *str)			/* String to convert in place. */
+Tcl_UtfToUpper(str)
+    char *str;			/* String to convert in place. */
 {
     Tcl_UniChar ch, upChar;
     char *src, *dst;
@@ -829,13 +830,13 @@ Tcl_UtfToUpper(
 
     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)) {
@@ -855,12 +856,12 @@ Tcl_UtfToUpper(
  *
  * 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.
@@ -869,8 +870,8 @@ Tcl_UtfToUpper(
  */
 
 int
-Tcl_UtfToLower(
-    char *str)			/* String to convert in place. */
+Tcl_UtfToLower(str)
+    char *str;			/* String to convert in place. */
 {
     Tcl_UniChar ch, lowChar;
     char *src, *dst;
@@ -886,9 +887,9 @@ Tcl_UtfToLower(
 	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)) {
@@ -908,13 +909,13 @@ Tcl_UtfToLower(
  *
  * 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.
@@ -923,8 +924,8 @@ Tcl_UtfToLower(
  */
 
 int
-Tcl_UtfToTitle(
-    char *str)			/* String to convert in place. */
+Tcl_UtfToTitle(str)
+    char *str;			/* String to convert in place. */
 {
     Tcl_UniChar ch, titleChar, lowChar;
     char *src, *dst;
@@ -970,8 +971,8 @@ Tcl_UtfToTitle(
  *
  * TclpUtfNcmp2 --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -983,28 +984,26 @@ Tcl_UtfToTitle(
  */
 
 int
-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. */
+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. */
 {
     /*
-     * 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.
+     * 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.
      */
-
     register int result = 0;
 
-    for ( ; numBytes != 0; numBytes--, cs++, ct++) {
+    for ( ; n != 0; n--, cs++, ct++) {
 	if (*cs != *ct) {
 	    result = UCHAR(*cs) - UCHAR(*ct);
 	    break;
 	}
     }
-    if (numBytes && ((UCHAR(*cs) == 0xC0) || (UCHAR(*ct) == 0xC0))) {
+    if (n && ((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);
@@ -1017,8 +1016,8 @@ TclpUtfNcmp2(
  *
  * Tcl_UtfNcmp --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -1030,26 +1029,23 @@ TclpUtfNcmp2(
  */
 
 int
-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_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_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 (numChars-- > 0) {
+    while (n-- > 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) {
@@ -1064,9 +1060,9 @@ Tcl_UtfNcmp(
  *
  * Tcl_UtfNcasecmp --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
@@ -1078,13 +1074,13 @@ Tcl_UtfNcmp(
  */
 
 int
-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_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_UniChar ch1, ch2;
-    while (numChars-- > 0) {
+    while (n-- > 0) {
 	/*
 	 * n must be interpreted as chars, not bytes.
 	 * This should be called only when both strings are of
@@ -1120,8 +1116,8 @@ Tcl_UtfNcasecmp(
  */
 
 Tcl_UniChar
-Tcl_UniCharToUpper(
-    int ch)			/* Unicode character to convert. */
+Tcl_UniCharToUpper(ch)
+    int ch;			/* Unicode character to convert. */
 {
     int info = GetUniCharInfo(ch);
 
@@ -1148,8 +1144,8 @@ Tcl_UniCharToUpper(
  */
 
 Tcl_UniChar
-Tcl_UniCharToLower(
-    int ch)			/* Unicode character to convert. */
+Tcl_UniCharToLower(ch)
+    int ch;			/* Unicode character to convert. */
 {
     int info = GetUniCharInfo(ch);
 
@@ -1176,8 +1172,8 @@ Tcl_UniCharToLower(
  */
 
 Tcl_UniChar
-Tcl_UniCharToTitle(
-    int ch)			/* Unicode character to convert. */
+Tcl_UniCharToTitle(ch)
+    int ch;			/* Unicode character to convert. */
 {
     int info = GetUniCharInfo(ch);
     int mode = GetCaseType(info);
@@ -1199,7 +1195,7 @@ Tcl_UniCharToTitle(
  *
  * 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:
@@ -1212,14 +1208,14 @@ Tcl_UniCharToTitle(
  */
 
 int
-Tcl_UniCharLen(
-    const Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
+Tcl_UniCharLen(str)
+    CONST Tcl_UniChar *str;	/* Unicode string to find length of. */
 {
     int len = 0;
 
-    while (*uniStr != '\0') {
+    while (*str != '\0') {
 	len++;
-	uniStr++;
+	str++;
     }
     return len;
 }
@@ -1229,11 +1225,11 @@ Tcl_UniCharLen(
  *
  * Tcl_UniCharNcmp --
  *
- *	Compare at most numChars unichars of string ucs to string uct.
- *	Both ucs and uct are assumed to be at least numChars unichars long.
+ *	Compare at most n unichars of string cs to string ct.  Both cs
+ *	and ct are assumed to be at least n unichars long.
  *
  * Results:
- *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
+ *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
  *
  * Side effects:
  *	None.
@@ -1242,26 +1238,24 @@ Tcl_UniCharLen(
  */
 
 int
-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. */
+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. */
 {
 #ifdef WORDS_BIGENDIAN
     /*
      * We are definitely on a big-endian machine; memcmp() is safe
      */
-
-    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));
+    return memcmp(cs, ct, n*sizeof(Tcl_UniChar));
 
 #else /* !WORDS_BIGENDIAN */
     /*
      * We can't simply call memcmp() because that is not lexically correct.
      */
-
-    for ( ; numChars != 0; ucs++, uct++, numChars--) {
-	if (*ucs != *uct) {
-	    return (*ucs - *uct);
+    for ( ; n != 0; cs++, ct++, n--) {
+	if (*cs != *ct) {
+	    return (*cs - *ct);
 	}
     }
     return 0;
@@ -1273,12 +1267,12 @@ Tcl_UniCharNcmp(
  *
  * Tcl_UniCharNcasecmp --
  *
- *	Compare at most numChars unichars of string ucs to string uct case
- *	insensitive. Both ucs and uct are assumed to be at least numChars
+ *	Compare at most n unichars of string cs to string ct case
+ *	insensitive.  Both cs and ct are assumed to be at least n
  *	unichars long.
  *
  * Results:
- *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
+ *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
  *
  * Side effects:
  *	None.
@@ -1287,16 +1281,15 @@ Tcl_UniCharNcmp(
  */
 
 int
-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. */
+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. */
 {
-    for ( ; numChars != 0; numChars--, ucs++, uct++) {
-	if (*ucs != *uct) {
-	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
-	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
-
+    for ( ; n != 0; n--, cs++, ct++) {
+	if (*cs != *ct) {
+	    Tcl_UniChar lcs = Tcl_UniCharToLower(*cs);
+	    Tcl_UniChar lct = Tcl_UniCharToLower(*ct);
 	    if (lcs != lct) {
 		return (lcs - lct);
 	    }
@@ -1322,8 +1315,8 @@ Tcl_UniCharNcasecmp(
  */
 
 int
-Tcl_UniCharIsAlnum(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsAlnum(ch)
+    int ch;			/* Unicode character to test. */
 {
     return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
 }
@@ -1345,8 +1338,8 @@ Tcl_UniCharIsAlnum(
  */
 
 int
-Tcl_UniCharIsAlpha(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsAlpha(ch)
+    int ch;			/* Unicode character to test. */
 {
     return ((ALPHA_BITS >> GetCategory(ch)) & 1);
 }
@@ -1368,8 +1361,8 @@ Tcl_UniCharIsAlpha(
  */
 
 int
-Tcl_UniCharIsControl(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsControl(ch)
+    int ch;			/* Unicode character to test. */
 {
     return ((CONTROL_BITS >> GetCategory(ch)) & 1);
 }
@@ -1391,8 +1384,8 @@ Tcl_UniCharIsControl(
  */
 
 int
-Tcl_UniCharIsDigit(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsDigit(ch)
+    int ch;			/* Unicode character to test. */
 {
     return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
 }
@@ -1414,8 +1407,8 @@ Tcl_UniCharIsDigit(
  */
 
 int
-Tcl_UniCharIsGraph(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsGraph(ch)
+    int ch;			/* Unicode character to test. */
 {
     return ((GRAPH_BITS >> GetCategory(ch)) & 1);
 }
@@ -1437,8 +1430,8 @@ Tcl_UniCharIsGraph(
  */
 
 int
-Tcl_UniCharIsLower(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsLower(ch)
+    int ch;			/* Unicode character to test. */
 {
     return (GetCategory(ch) == LOWERCASE_LETTER);
 }
@@ -1460,8 +1453,8 @@ Tcl_UniCharIsLower(
  */
 
 int
-Tcl_UniCharIsPrint(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsPrint(ch)
+    int ch;			/* Unicode character to test. */
 {
     return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
 }
@@ -1483,8 +1476,8 @@ Tcl_UniCharIsPrint(
  */
 
 int
-Tcl_UniCharIsPunct(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsPunct(ch)
+    int ch;			/* Unicode character to test. */
 {
     return ((PUNCT_BITS >> GetCategory(ch)) & 1);
 }
@@ -1506,8 +1499,8 @@ Tcl_UniCharIsPunct(
  */
 
 int
-Tcl_UniCharIsSpace(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsSpace(ch)
+    int ch;			/* Unicode character to test. */
 {
     /*
      * If the character is within the first 127 characters, just use the
@@ -1538,8 +1531,8 @@ Tcl_UniCharIsSpace(
  */
 
 int
-Tcl_UniCharIsUpper(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsUpper(ch)
+    int ch;			/* Unicode character to test. */
 {
     return (GetCategory(ch) == UPPERCASE_LETTER);
 }
@@ -1549,7 +1542,8 @@ Tcl_UniCharIsUpper(
  *
  * 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.
@@ -1561,8 +1555,8 @@ Tcl_UniCharIsUpper(
  */
 
 int
-Tcl_UniCharIsWordChar(
-    int ch)			/* Unicode character to test. */
+Tcl_UniCharIsWordChar(ch)
+    int ch;			/* Unicode character to test. */
 {
     return ((WORD_BITS >> GetCategory(ch)) & 1);
 }
@@ -1573,16 +1567,17 @@ Tcl_UniCharIsWordChar(
  * 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.
@@ -1591,34 +1586,33 @@ Tcl_UniCharIsWordChar(
  */
 
 int
-Tcl_UniCharCaseMatch(
-    const Tcl_UniChar *uniStr,	/* Unicode String. */
-    const Tcl_UniChar *uniPattern,
-				/* Pattern, which may contain special
+Tcl_UniCharCaseMatch(string, pattern, nocase)
+    CONST Tcl_UniChar *string;	/* Unicode String. */
+    CONST Tcl_UniChar *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 */
 {
     Tcl_UniChar ch1, p;
 
     while (1) {
-	p = *uniPattern;
+	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 (*uniStr == 0);
+	    return (*string == 0);
 	}
-	if ((*uniStr == 0) && (p != '*')) {
+	if ((*string == 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.
@@ -1628,11 +1622,8 @@ Tcl_UniCharCaseMatch(
 	    /*
 	     * Skip all successive *'s in the pattern
 	     */
-
-	    while (*(++uniPattern) == '*') {
-		/* empty body */
-	    }
-	    p = *uniPattern;
+	    while (*(++pattern) == '*') {}
+	    p = *pattern;
 	    if (p == 0) {
 		return 1;
 	    }
@@ -1645,67 +1636,63 @@ Tcl_UniCharCaseMatch(
 		 * quickly if the next char in the pattern isn't a special
 		 * character
 		 */
-
 		if ((p != '[') && (p != '?') && (p != '\\')) {
 		    if (nocase) {
-			while (*uniStr && (p != *uniStr)
-				&& (p != Tcl_UniCharToLower(*uniStr))) {
-			    uniStr++;
+			while (*string && (p != *string)
+				&& (p != Tcl_UniCharToLower(*string))) {
+			    string++;
 			}
 		    } else {
-			while (*uniStr && (p != *uniStr)) {
-			    uniStr++;
-			}
+			while (*string && (p != *string)) { string++; }
 		    }
 		}
-		if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) {
+		if (Tcl_UniCharCaseMatch(string, pattern, nocase)) {
 		    return 1;
 		}
-		if (*uniStr == 0) {
+		if (*string == 0) {
 		    return 0;
 		}
-		uniStr++;
+		string++;
 	    }
 	}
 
 	/*
-	 * 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 == '?') {
-	    uniPattern++;
-	    uniStr++;
+	    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 "-").
+	 * 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;
 
-	    uniPattern++;
-	    ch1 = (nocase ? Tcl_UniCharToLower(*uniStr) : *uniStr);
-	    uniStr++;
+	    pattern++;
+	    ch1 = (nocase ? Tcl_UniCharToLower(*string) : *string);
+	    string++;
 	    while (1) {
-		if ((*uniPattern == ']') || (*uniPattern == 0)) {
+		if ((*pattern == ']') || (*pattern == 0)) {
 		    return 0;
 		}
-		startChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
-			: *uniPattern);
-		uniPattern++;
-		if (*uniPattern == '-') {
-		    uniPattern++;
-		    if (*uniPattern == 0) {
+		startChar = (nocase ? Tcl_UniCharToLower(*pattern) : *pattern);
+		pattern++;
+		if (*pattern == '-') {
+		    pattern++;
+		    if (*pattern == 0) {
 			return 0;
 		    }
-		    endChar = (nocase ? Tcl_UniCharToLower(*uniPattern)
-			    : *uniPattern);
-		    uniPattern++;
+		    endChar = (nocase ? Tcl_UniCharToLower(*pattern)
+			    : *pattern);
+		    pattern++;
 		    if (((startChar <= ch1) && (ch1 <= endChar))
 			    || ((endChar <= ch1) && (ch1 <= startChar))) {
 			/*
@@ -1717,43 +1704,42 @@ Tcl_UniCharCaseMatch(
 		    break;
 		}
 	    }
-	    while (*uniPattern != ']') {
-		if (*uniPattern == 0) {
-		    uniPattern--;
+	    while (*pattern != ']') {
+		if (*pattern == 0) {
+		    pattern--;
 		    break;
 		}
-		uniPattern++;
+		pattern++;
 	    }
-	    uniPattern++;
+	    pattern++;
 	    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 (*(++uniPattern) == '\0') {
+	    if (*(++pattern) == '\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(*uniStr) !=
-		    Tcl_UniCharToLower(*uniPattern)) {
+	    if (Tcl_UniCharToLower(*string) != Tcl_UniCharToLower(*pattern)) {
 		return 0;
 	    }
-	} else if (*uniStr != *uniPattern) {
+	} else if (*string != *pattern) {
 	    return 0;
 	}
-	uniStr++;
-	uniPattern++;
+	string++;
+	pattern++;
     }
 }
 
@@ -1763,14 +1749,15 @@ Tcl_UniCharCaseMatch(
  * 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.
@@ -1779,25 +1766,25 @@ Tcl_UniCharCaseMatch(
  */
 
 int
-TclUniCharMatch(
-    const Tcl_UniChar *string,	/* Unicode String. */
-    int strLen,			/* Length of String */
-    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
+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
 				 * 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;
+    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) {
@@ -1809,8 +1796,8 @@ TclUniCharMatch(
 	}
 
 	/*
-	 * 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.
@@ -1818,12 +1805,9 @@ TclUniCharMatch(
 
 	if (p == '*') {
 	    /*
-	     * Skip all successive *'s in the pattern.
+	     * Skip all successive *'s in the pattern
 	     */
-
-	    while (*(++pattern) == '*') {
-		/* empty body */
-	    }
+	    while (*(++pattern) == '*') {}
 	    if (pattern == patternEnd) {
 		return 1;
 	    }
@@ -1835,9 +1819,8 @@ TclUniCharMatch(
 		/*
 		 * 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)
@@ -1862,8 +1845,8 @@ TclUniCharMatch(
 	}
 
 	/*
-	 * 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 == '?') {
@@ -1873,9 +1856,9 @@ TclUniCharMatch(
 	}
 
 	/*
-	 * 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 == '[') {
@@ -1921,8 +1904,8 @@ TclUniCharMatch(
 	}
 
 	/*
-	 * 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 == '\\') {
@@ -1932,8 +1915,8 @@ TclUniCharMatch(
 	}
 
 	/*
-	 * 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) {
@@ -1947,11 +1930,3 @@ TclUniCharMatch(
 	pattern++;
     }
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index d5a3b94..b327b99 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1,466 +1,118 @@
-/*
+/* 
  * tclUtil.c --
  *
- *	This file contains utility functions that are used by many Tcl
+ *	This file contains utility procedures 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 "tclParse.h"
-#include <math.h>
+#include "tclPort.h"
 
 /*
- * The absolute pathname of the executable in which this Tcl library is
- * running.
+ * 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.
  */
 
-static ProcessGlobalValue executableName = {
-    0, 0, NULL, NULL, NULL, NULL, NULL
-};
+char *tclExecutableName = NULL;
+char *tclNativeExecutableName = NULL;
 
 /*
- * 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.
+ * 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.
  */
 
-#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
+#define USE_BRACES		2
+#define BRACES_UNMATCHED	4
 
 /*
- * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
- * access the precision to be used for double formatting.
+ * 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.
  */
 
-static Tcl_ThreadDataKey precisionKey;
+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)
 
 /*
- * Prototypes for functions defined later in this file.
+ * Prototypes for procedures defined later in this file.
  */
 
-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);
+static void UpdateStringOfEndOffset _ANSI_ARGS_((Tcl_Obj* objPtr));
+static int SetEndOffsetFromAny _ANSI_ARGS_((Tcl_Interp* interp,
+					    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.
  */
 
-const Tcl_ObjType tclEndOffsetType = {
+Tcl_ObjType tclEndOffsetType = {
     "end-offset",			/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
+    (Tcl_FreeInternalRepProc*) NULL,    /* freeIntRepProc */
+    (Tcl_DupInternalRepProc*) 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 interpretaton 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 sequent 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 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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -469,46 +121,43 @@ TclMaxListLength(
  */
 
 int
-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
+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
 				 * 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 *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. */
+    int *bracePtr;		/* If non-zero, fill in with non-zero/zero
+				 * to indicate that arg was/wasn't
+				 * in braces. */
 {
-    const char *p = list;
-    const char *elemStart;	/* Points to first byte of first element. */
-    const char *limit;		/* Points just after list's last byte. */
+    CONST char *p = list;
+    CONST char *elemStart;	/* Points to first byte of first element. */
+    CONST char *limit;		/* Points just after list's last byte. */
     int openBraces = 0;		/* Brace nesting level during parse. */
     int inQuotes = 0;
     int size = 0;		/* lint. */
     int numChars;
-    int literal = 1;
-    const char *p2;
-
+    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) && (TclIsSpaceProc(*p))) {
+    while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
 	p++;
     }
     if (p == limit) {		/* no element found */
@@ -524,6 +173,9 @@ TclFindElement(
 	p++;
     }
     elemStart = p;
+    if (bracePtr != 0) {
+	*bracePtr = openBraces;
+    }
 
     /*
      * Find element's end (a space, close brace, or the end of the string).
@@ -531,123 +183,123 @@ TclFindElement(
 
     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) || TclIsSpaceProc(*p)) {
-		    goto done;
-		}
-
-		/*
-		 * Garbage after the closing brace; return an error.
-		 */
+	    case '}':
+		if (openBraces > 1) {
+		    openBraces--;
+		} else if (openBraces == 1) {
+		    size = (p - elemStart);
+		    p++;
+		    if ((p >= limit)
+			    || isspace(UCHAR(*p))) { /* INTL: ISO space. */
+			goto done;
+		    }
 
-		if (interp != NULL) {
-		    p2 = p;
-		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))
-			    && (p2 < p+20)) {
-			p2++;
+		    /*
+		     * 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);
 		    }
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "list element in braces followed by \"%.*s\" "
-			    "instead of space", (int) (p2-p), p));
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
-			    NULL);
+		    return TCL_ERROR;
 		}
-		return TCL_ERROR;
-	    }
-	    break;
+		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 '\\':
-	    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;
+	    case '\\': {
+		TclParseBackslash(p, limit - p, &numChars, NULL);
+		p += (numChars - 1);
+		break;
 	    }
-	    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) || TclIsSpaceProc(*p)) {
-		    goto done;
-		}
-
-		/*
-		 * Garbage after the closing quote; return an error.
-		 */
+	    case '"':
+		if (inQuotes) {
+		    size = (p - elemStart);
+		    p++;
+		    if ((p >= limit)
+			    || isspace(UCHAR(*p))) { /* INTL: ISO space */
+			goto done;
+		    }
 
-		if (interp != NULL) {
-		    p2 = p;
-		    while ((p2 < limit) && (!TclIsSpaceProc(*p2))
-			    && (p2 < p+20)) {
-			p2++;
+		    /*
+		     * 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);
 		    }
-		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			    "list element in quotes followed by \"%.*s\" "
-			    "instead of space", (int) (p2-p), p));
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
-			    NULL);
+		    return TCL_ERROR;
 		}
-		return TCL_ERROR;
-	    }
-	    break;
+		break;
 	}
 	p++;
     }
 
+
     /*
      * End of list: terminate element.
      */
@@ -657,24 +309,20 @@ TclFindElement(
 	    if (interp != NULL) {
 		Tcl_SetResult(interp, "unmatched open brace in list",
 			TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
-			NULL);
 	    }
 	    return TCL_ERROR;
 	} else if (inQuotes) {
 	    if (interp != NULL) {
 		Tcl_SetResult(interp, "unmatched open quote in list",
 			TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
-			NULL);
 	    }
 	    return TCL_ERROR;
 	}
 	size = (p - elemStart);
     }
 
-  done:
-    while ((p < limit) && (TclIsSpaceProc(*p))) {
+    done:
+    while ((p < limit) && (isspace(UCHAR(*p)))) { /* INTL: ISO space. */
 	p++;
     }
     *elementPtr = elemStart;
@@ -682,9 +330,6 @@ TclFindElement(
     if (sizePtr != 0) {
 	*sizePtr = size;
     }
-    if (literalPtr != 0) {
-	*literalPtr = literal;
-    }
     return TCL_OK;
 }
 
@@ -693,7 +338,7 @@ TclFindElement(
  *
  * TclCopyAndCollapse --
  *
- *	Copy a string and substitute all backslash escape sequences
+ *	Copy a string and eliminate any backslashes that aren't in braces.
  *
  * Results:
  *	Count bytes get copied from src to dst. Along the way, backslash
@@ -708,10 +353,10 @@ TclFindElement(
  */
 
 int
-TclCopyAndCollapse(
-    int count,			/* Number of byte to copy from src. */
-    const char *src,		/* Copy from here... */
-    char *dst)			/* ... to here. */
+TclCopyAndCollapse(count, src, dst)
+    int count;			/* Number of bytes to copy from src. */
+    CONST char *src;		/* Copy from here... */
+    char *dst;			/* ... to here. */
 {
     int newCount = 0;
 
@@ -745,19 +390,21 @@ TclCopyAndCollapse(
  *	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
- *	function 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 procedure returns normally.
  *
  * Side effects:
  *	Memory is allocated.
@@ -766,65 +413,79 @@ TclCopyAndCollapse(
  */
 
 int
-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. */
+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. */
 {
-    const char **argv, *end, *element;
+    CONST char **argv;
+    CONST char *l;
     char *p;
-    int length, size, i, result, elSize;
+    int length, size, i, result, elSize, brace;
+    CONST char *element;
 
     /*
-     * 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.
+     * 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.
      */
 
-    size = TclMaxListLength(list, -1, &end) + 1;
-    length = end - list;
-    argv = ckalloc((size * sizeof(char *)) + length + 1);
-
+    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;
+    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;
-	int literal;
-
-	result = TclFindElement(interp, list, length, &element, &list,
-		&elSize, &literal);
+	CONST char *prevList = list;
+	
+	result = TclFindElement(interp, list, length, &element,
+				&list, &elSize, &brace);
 	length -= (list - prevList);
 	if (result != TCL_OK) {
-	    ckfree(argv);
+	    ckfree((char *) argv);
 	    return result;
 	}
 	if (*element == 0) {
 	    break;
 	}
 	if (i >= size) {
-	    ckfree(argv);
+	    ckfree((char *) argv);
 	    if (interp != NULL) {
 		Tcl_SetResult(interp, "internal error in Tcl_SplitList",
 			TCL_STATIC);
-		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
-			NULL);
 	    }
 	    return TCL_ERROR;
 	}
 	argv[i] = p;
-	if (literal) {
-	    memcpy(p, element, (size_t) elSize);
+	if (brace) {
+	    memcpy((VOID *) p, (VOID *) element, (size_t) elSize);
 	    p += elSize;
 	    *p = 0;
 	    p++;
 	} else {
-	    p += 1 + TclCopyAndCollapse(elSize, element, p);
+	    TclCopyAndCollapse(elSize, element, p);
+	    p += elSize+1;
 	}
     }
 
@@ -839,15 +500,17 @@ Tcl_SplitList(
  *
  * Tcl_ScanElement --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -856,12 +519,12 @@ Tcl_SplitList(
  */
 
 int
-Tcl_ScanElement(
-    register const char *src,	/* String to convert to list element. */
-    register int *flagPtr)	/* Where to store information to guide
-				 * Tcl_ConvertCountedElement. */
+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. */
 {
-    return Tcl_ScanCountedElement(src, -1, flagPtr);
+    return Tcl_ScanCountedElement(string, -1, flagPtr);
 }
 
 /*
@@ -869,17 +532,19 @@ Tcl_ScanElement(
  *
  * Tcl_ScanCountedElement --
  *
- *	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.
+ *	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.
  *
  * Results:
- *	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.
+ *	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.
  *
  * Side effects:
  *	None.
@@ -888,268 +553,115 @@ Tcl_ScanElement(
  */
 
 int
-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_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_ConvertElement. */
 {
-    int flags = CONVERT_ANY;
-    int numBytes = TclScanElement(src, length, &flags);
+    int flags, nestingLevel;
+    register CONST char *p, *lastChar;
 
-    *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.
- *
- *----------------------------------------------------------------------
- */
+    /*
+     * 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.
+     */
 
-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;
+    nestingLevel = 0;
+    flags = 0;
+    if (string == NULL) {
+	string = "";
     }
-
-    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
+    if (length == -1) {
+	length = strlen(string);
     }
-
-    while (length) {
-      if (CHAR_TYPE(*p) != TYPE_NORMAL) {
+    lastChar = string + length;
+    p = string;
+    if ((p == lastChar) || (*p == '{') || (*p == '"')) {
+	flags |= USE_BRACES;
+    }
+    for ( ; p < lastChar; p++) {
 	switch (*p) {
-	case '{':	/* TYPE_BRACE */
-#if COMPAT
-	    braceCount++;
-#endif
-	    extra++;				/* Escape '{' => '\{' */
-	    nestingLevel++;
-	    break;
-	case '}':	/* TYPE_BRACE */
-#if COMPAT
-	    braceCount++;
-#endif
-	    extra++;				/* Escape '}' => '\}' */
-	    nestingLevel--;
-	    if (nestingLevel < 0) {
-		/* Unbalanced braces!  Cannot format with brace quoting. */
-		requireEscape = 1;
-	    }
-	    break;
-	case ']':	/* TYPE_CLOSE_BRACK */
-	case '"':	/* TYPE_SPACE */
-#if COMPAT
-	    forbidNone = 1;
-	    extra++;		/* Escapes all just prepend a backslash */
-	    preferEscape = 1;
-	    break;
-#else
-	    /* FLOW THROUGH */
-#endif
-	case '[':	/* TYPE_SUBS */
-	case '$':	/* TYPE_SUBS */
-	case ';':	/* TYPE_COMMAND_END */
-	case ' ':	/* TYPE_SPACE */
-	case '\f':	/* TYPE_SPACE */
-	case '\n':	/* TYPE_COMMAND_END */
-	case '\r':	/* TYPE_SPACE */
-	case '\t':	/* TYPE_SPACE */
-	case '\v':	/* TYPE_SPACE */
-	    forbidNone = 1;
-	    extra++;		/* Escape sequences all one byte longer. */
-#if COMPAT
-	    preferBrace = 1;
-#endif
-	    break;
-	case '\\':	/* TYPE_SUBS */
-	    extra++;				/* Escape '\' => '\\' */
-	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
-		/* Final backslash. Cannot format with brace quoting. */
-		requireEscape = 1;		
+	    case '{':
+		nestingLevel++;
 		break;
-	    }
-	    if (p[1] == '\n') {
-		extra++;	/* Escape newline => '\n', one byte longer */
-		/* Backslash newline sequence.  Brace quoting not permitted. */
-		requireEscape = 1;
-		length -= (length > 0);
-		p++;
+	    case '}':
+		nestingLevel--;
+		if (nestingLevel < 0) {
+		    flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
+		}
 		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':	/* TYPE_SUBS */
-	    if (length == -1) {
-		goto endOfString;
-	    }
-	    /* TODO: Panic on improper encoding? */
-	    break;
-	}
-      }
-	length -= (length > 0);
-	p++;
-    }
-
-    endOfString:
-    if (nestingLevel != 0) {
-	/* Unbalanced braces!  Cannot format with brace quoting. */
-	requireEscape = 1;
-    }
-
-    /* We need at least as many bytes as are in the element value... */
-    bytesNeeded = p - src;
+	    case '[':
+	    case '$':
+	    case ';':
+	    case ' ':
+	    case '\f':
+	    case '\n':
+	    case '\r':
+	    case '\t':
+	    case '\v':
+		flags |= USE_BRACES;
+		break;
+	    case '\\':
+		if ((p+1 == lastChar) || (p[1] == '\n')) {
+		    flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
+		} else {
+		    int size;
 
-    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;
+		    TclParseBackslash(p, lastChar - p, &size, NULL);
+		    p += size-1;
+		    flags |= USE_BRACES;
+		}
+		break;
 	}
-	*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;
+    if (nestingLevel != 0) {
+	flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
     }
+    *flagPtr = flags;
 
-    /* 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;
+    /*
+     * Allow enough space to backslash every character plus leave
+     * two spaces for braces.
+     */
 
-    overflowCheck:
-    if (bytesNeeded < 0) {
-	Tcl_Panic("TclScanElement: string length overflow");
-    }
-    return bytesNeeded;
+    return 2*(p-string) + 2;
 }
 
 /*
@@ -1157,15 +669,16 @@ TclScanElement(
  *
  * Tcl_ConvertElement --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -1174,10 +687,10 @@ TclScanElement(
  */
 
 int
-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. */
+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. */
 {
     return Tcl_ConvertCountedElement(src, -1, dst, flags);
 }
@@ -1187,15 +700,17 @@ Tcl_ConvertElement(
  *
  * Tcl_ConvertCountedElement --
  *
- *	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.
+ *	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.
  *
  * 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.
@@ -1204,177 +719,118 @@ Tcl_ConvertElement(
  */
 
 int
-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. */
+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. */
 {
-    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.
- *
- *----------------------------------------------------------------------
- */
+    register char *p = dst;
+    register CONST char *lastChar;
 
-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;
-
-    /* Let the caller demand we use escape sequences rather than braces. */
-    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
-	conversion = CONVERT_ESCAPE;
-    }
-
-    /* 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;
-    }
+    /*
+     * See the comment block at the beginning of the Tcl_ScanElement
+     * code for details of how this works.
+     */
 
-    /* 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;
-	}
+    if (src && length == -1) {
+	length = strlen(src);
     }
-
-    /* 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;
-	}
+    if ((src == NULL) || (length == 0)) {
+	p[0] = '{';
+	p[1] = '}';
+	p[2] = 0;
+	return 2;
     }
-
-    /* Formatted string is original string enclosed in braces. */
-    if (conversion == CONVERT_BRACE) {
+    lastChar = src + length;
+    if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
 	*p = '{';
 	p++;
-	if (length == -1) {
-	    /* TODO: INT_MAX overflow? */
-	    while (*src) {
-		*p++ = *src++;
-	    }
-	} else {
-	    memcpy(p, src, length);
-	    p += length;
+	for ( ; src != lastChar; src++, p++) {
+	    *p = *src;
 	}
 	*p = '}';
 	p++;
-	return p - dst;
-    }
-
-    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */
+    } 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.
+	     */
 
-    /* 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[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;
 	    }
-#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 = *src;
 	    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++;
     }
-    return p - dst;
+    *p = '\0';
+    return p-dst;
 }
 
 /*
@@ -1382,14 +838,15 @@ int TclConvertElement(
  *
  * 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.
@@ -1398,25 +855,16 @@ int TclConvertElement(
  */
 
 char *
-Tcl_Merge(
-    int argc,			/* How many strings to merge. */
-    const char *const *argv)	/* Array of string values. */
+Tcl_Merge(argc, argv)
+    int argc;			/* How many strings to merge. */
+    CONST char * CONST *argv;	/* Array of string values. */
 {
 #   define LOCAL_SIZE 20
-    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;
-    }
+    int localFlags[LOCAL_SIZE], *flagPtr;
+    int numChars;
+    char *result;
+    char *dst;
+    int i;
 
     /*
      * Pass 1: estimate space, gather flags.
@@ -1424,51 +872,34 @@ Tcl_Merge(
 
     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 = ckalloc(argc * sizeof(int));
+	flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
     }
+    numChars = 1;
     for (i = 0; i < argc; i++) {
-	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);
-	}
+	numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
     }
-    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 = ckalloc(bytesNeeded);
+    result = (char *) ckalloc((unsigned) numChars);
     dst = result;
     for (i = 0; i < argc; i++) {
-	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
-	dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
+	numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
+	dst += numChars;
 	*dst = ' ';
 	dst++;
     }
-    dst[-1] = 0;
+    if (dst == result) {
+	*dst = 0;
+    } else {
+	dst[-1] = 0;
+    }
 
     if (flagPtr != localFlags) {
-	ckfree(flagPtr);
+	ckfree((char *) flagPtr);
     }
     return result;
 }
@@ -1481,10 +912,10 @@ Tcl_Merge(
  *	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.
@@ -1493,11 +924,11 @@ Tcl_Merge(
  */
 
 char
-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. */
+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. */
 {
     char buf[TCL_UTF_MAX];
     Tcl_UniChar ch;
@@ -1510,228 +941,73 @@ Tcl_Backslash(
 /*
  *----------------------------------------------------------------------
  *
- * 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(
-    int argc,			/* Number of strings to concatenate. */
-    const char *const *argv)	/* Array of strings to concatenate. */
+Tcl_Concat(argc, argv)
+    int argc;			/* Number of strings to concatenate. */
+    CONST char * CONST *argv;	/* Array of strings to concatenate. */
 {
-    int i, needSpace = 0, bytesNeeded = 0;
-    char *result, *p;
+    int totalSize, i;
+    char *p;
+    char *result;
 
-    /* Dispose of the empty result corner case first to simplify later code */
+    for (totalSize = 1, i = 0; i < argc; i++) {
+	totalSize += strlen(argv[i]) + 1;
+    }
+    result = (char *) ckalloc((unsigned) totalSize);
     if (argc == 0) {
-	result = (char *) ckalloc(1);
-	result[0] = '\0';
+	*result = '\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) {
 	/*
-	 * Panic test could be tighter, but not going to bother for 
-	 * this legacy routine.
+	 * Clip white space off the front and back of the string
+	 * to generate a neater result, and ignore any empty
+	 * elements.
 	 */
-	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];
-	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;
+	while (isspace(UCHAR(*element))) { /* INTL: ISO space. */
+	    element++;
 	}
-
-	/* Append to the result with space if needed */
-	if (needSpace) {
-	    *p++ = ' ';
+	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) {
+	    continue;
 	}
-	memcpy(p, element, (size_t) elemLength);
-	p += elemLength;
-	needSpace = 1;
+	memcpy((VOID *) p, (VOID *) element, (size_t) length);
+	p += length;
+	*p = ' ';
+	p++;
+    }
+    if (p != result) {
+	p[-1] = 0;
+    } else {
+	*p = 0;
     }
-    *p = '\0';
     return result;
 }
 
@@ -1744,8 +1020,8 @@ Tcl_Concat(
  *	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.
@@ -1754,105 +1030,120 @@ Tcl_Concat(
  */
 
 Tcl_Obj *
-Tcl_ConcatObj(
-    int objc,			/* Number of objects to concatenate. */
-    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
+Tcl_ConcatObj(objc, objv)
+    int objc;			/* Number of objects to concatenate. */
+    Tcl_Obj *CONST objv[];	/* Array of objects to concatenate. */
 {
-    int i, elemLength, needSpace = 0, bytesNeeded = 0;
-    const char *element;
-    Tcl_Obj *objPtr, *resPtr;
+    int allocSize, finalSize, length, elemLength, i;
+    char *p;
+    char *element;
+    char *concatStr;
+    Tcl_Obj *objPtr;
 
     /*
-     * 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.
+     * 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.
      */
-
     for (i = 0;  i < objc;  i++) {
-	int length;
-
 	objPtr = objv[i];
-	if (TclListObjIsCanonical(objPtr)) {
-	    continue;
-	}
-	Tcl_GetStringFromObj(objPtr, &length);
-	if (length > 0) {
+	if ((objPtr->typePtr != &tclListType) || (objPtr->bytes != NULL)) {
 	    break;
 	}
     }
     if (i == objc) {
-	resPtr = NULL;
+	Tcl_Obj **listv;
+	int listc;
+
+	objPtr = Tcl_NewListObj(0, NULL);
 	for (i = 0;  i < objc;  i++) {
-	    objPtr = objv[i];
-	    if (objPtr->bytes && objPtr->length == 0) {
-		continue;
-	    }
-	    if (resPtr) {
-		Tcl_ListObjAppendList(NULL, resPtr, objPtr);
-	    } else {
-		resPtr = TclListObjCopy(NULL, objPtr);
-	    }
-	}
-	if (!resPtr) {
-	    resPtr = Tcl_NewObj();
+	    /*
+	     * 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_ListObjGetElements(NULL, objv[i], &listc, &listv);
+	    Tcl_ListObjReplace(NULL, objPtr, INT_MAX, 0, listc, listv);
 	}
-	return resPtr;
+	return objPtr;
     }
 
-    /*
-     * Something cannot be determined to be safe, so build the concatenation
-     * the slow way, using the string representations.
-     */
-
-    /* First try to pre-allocate the size required */
+    allocSize = 0;
     for (i = 0;  i < objc;  i++) {
-	element = TclGetStringFromObj(objv[i], &elemLength);
-	bytesNeeded += elemLength;
-	if (bytesNeeded < 0) {
-	    break;
+	objPtr = objv[i];
+	element = Tcl_GetStringFromObj(objPtr, &length);
+	if ((element != NULL) && (length > 0)) {
+	    allocSize += (length + 1);
 	}
     }
+    if (allocSize == 0) {
+	allocSize = 1;		/* enough for the NULL byte at 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.
+     * 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.
      */
-    TclNewObj(resPtr);
-    Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
-    Tcl_SetObjLength(resPtr, 0);
-
-    for (i = 0;  i < objc;  i++) {
-	int trim;
-	
-	element = TclGetStringFromObj(objv[i], &elemLength);
-
-	/* Trim away the leading whitespace */
-	trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
-	element += trim;
-	elemLength -= trim;
+    
+    concatStr = (char *) ckalloc((unsigned) allocSize);
 
-	/*
-	 * Trim away the trailing whitespace.  Do not permit trimming
-	 * to expose a final backslash character.
-	 */
+    /*
+     * 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.
+     */
 
-	trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
-	trim -= trim && (element[elemLength - trim - 1] == '\\');
-	elemLength -= trim;
+    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--;
+	    }
 
-	/* If we're left with empty element after trimming, do nothing */
-	if (elemLength == 0) {
-	    continue;
-	}
+	    /*
+	     * 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.
+	     */
 
-	/* Append to the result with space if needed */
-	if (needSpace) {
-	    Tcl_AppendToObj(resPtr, " ", 1);
-	}
-	Tcl_AppendToObj(resPtr, element, elemLength);
-	needSpace = 1;
+	    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;
+        }
     }
-    return resPtr;
+    
+    TclNewObj(objPtr);
+    objPtr->bytes  = concatStr;
+    objPtr->length = finalSize;
+    return objPtr;
 }
 
 /*
@@ -1863,9 +1154,10 @@ Tcl_ConcatObj(
  *	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.
@@ -1874,12 +1166,12 @@ Tcl_ConcatObj(
  */
 
 int
-Tcl_StringMatch(
-    const char *str,		/* String. */
-    const char *pattern)	/* Pattern, which may contain special
+Tcl_StringMatch(string, pattern)
+    CONST char *string;		/* String. */
+    CONST char *pattern;	/* Pattern, which may contain special
 				 * characters. */
 {
-    return Tcl_StringCaseMatch(str, pattern, 0);
+    return Tcl_StringCaseMatch(string, pattern, 0);
 }
 
 /*
@@ -1887,13 +1179,14 @@ Tcl_StringMatch(
  *
  * 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.
@@ -1902,133 +1195,127 @@ Tcl_StringMatch(
  */
 
 int
-Tcl_StringCaseMatch(
-    const char *str,		/* String. */
-    const char *pattern,	/* Pattern, which may contain special
+Tcl_StringCaseMatch(string, pattern, nocase)
+    CONST char *string;		/* 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;
+    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 (*str == '\0');
+	    return (*string == '\0');
 	}
-	if ((*str == '\0') && (p != '*')) {
+	if ((*string == '\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 (*str) {
-			    charLen = TclUtfToUniChar(str, &ch1);
+			while (*string) {
+			    charLen = TclUtfToUniChar(string, &ch1);
 			    if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
 				break;
 			    }
-			    str += charLen;
+			    string += 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 (*str) {
-			    charLen = TclUtfToUniChar(str, &ch1);
+			while (*string) {
+			    charLen = TclUtfToUniChar(string, &ch1);
 			    if (ch2 == ch1) {
 				break;
 			    }
-			    str += charLen;
+			    string += charLen;
 			}
 		    }
 		}
-		if (Tcl_StringCaseMatch(str, pattern, nocase)) {
+		if (Tcl_StringCaseMatch(string, pattern, nocase)) {
 		    return 1;
 		}
-		if (*str == '\0') {
+		if (*string == '\0') {
 		    return 0;
 		}
-		str += TclUtfToUniChar(str, &ch1);
+		string += TclUtfToUniChar(string, &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++;
-	    str += TclUtfToUniChar(str, &ch1);
+	    string += TclUtfToUniChar(string, &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(*str) < 0x80) {
+	    if (UCHAR(*string) < 0x80) {
 		ch1 = (Tcl_UniChar)
-			(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
-		str++;
+		    (nocase ? tolower(UCHAR(*string)) : UCHAR(*string));
+		string++;
 	    } else {
-		str += Tcl_UtfToUniChar(str, &ch1);
+		string += Tcl_UtfToUniChar(string, &ch1);
 		if (nocase) {
 		    ch1 = Tcl_UniCharToLower(ch1);
 		}
@@ -2038,8 +1325,8 @@ Tcl_StringCaseMatch(
 		    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);
@@ -2053,8 +1340,9 @@ Tcl_StringCaseMatch(
 			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);
@@ -2086,8 +1374,8 @@ Tcl_StringCaseMatch(
 	}
 
 	/*
-	 * 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 == '\\') {
@@ -2098,11 +1386,11 @@ Tcl_StringCaseMatch(
 	}
 
 	/*
-	 * 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.
 	 */
 
-	str += TclUtfToUniChar(str, &ch1);
+	string  += TclUtfToUniChar(string, &ch1);
 	pattern += TclUtfToUniChar(pattern, &ch2);
 	if (nocase) {
 	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
@@ -2117,16 +1405,14 @@ Tcl_StringCaseMatch(
 /*
  *----------------------------------------------------------------------
  *
- * TclByteArrayMatch --
+ * TclMatchIsTrivial --
  *
- *	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.
+ *	Test whether a particular glob pattern is a trivial pattern.
+ *	(i.e. where matching is the same as equality testing).
  *
  * 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).
+ *	A boolean indicating whether the pattern is free of all of the
+ *	glob special chars.
  *
  * Side effects:
  *	None.
@@ -2135,224 +1421,32 @@ Tcl_StringCaseMatch(
  */
 
 int
-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)
+TclMatchIsTrivial(pattern)
+    CONST char *pattern;
 {
-    const unsigned char *stringEnd, *patternEnd;
-    unsigned char p;
-
-    stringEnd = string + strLen;
-    patternEnd = pattern + ptnLen;
+    CONST char *p = pattern;
 
     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.
-	 */
-
-	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) {
+	switch (*p++) {
+	case '\0':
+	    return 1;
+	case '*':
+	case '?':
+	case '[':
+	case '\\':
 	    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) || (strObj->typePtr == NULL)) {
-	Tcl_UniChar *udata, *uptn;
-
-	udata = Tcl_GetUnicodeFromObj(strObj, &length);
-	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
-	match = TclUniCharMatch(udata, length, uptn, plen, flags);
-    } else if (TclIsPureByteArray(strObj) && !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.
@@ -2364,8 +1458,8 @@ TclStringMatchObj(
  */
 
 void
-Tcl_DStringInit(
-    Tcl_DString *dsPtr)		/* Pointer to structure for dynamic string. */
+Tcl_DStringInit(dsPtr)
+    Tcl_DString *dsPtr;		/* Pointer to structure for dynamic string. */
 {
     dsPtr->string = dsPtr->staticSpace;
     dsPtr->length = 0;
@@ -2378,60 +1472,69 @@ Tcl_DStringInit(
  *
  * Tcl_DStringAppend --
  *
- *	Append more bytes to the current value of a dynamic string.
+ *	Append more characters 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 "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.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
 char *
-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. */
+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. */
 {
     int newSize;
+    char *dst;
+    CONST char *end;
 
     if (length < 0) {
-	length = strlen(bytes);
+	length = strlen(string);
     }
     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 = ckalloc(dsPtr->spaceAvl);
+	    char *newString;
 
-	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
+	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+	    memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		    (size_t) dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
+	    dsPtr->string = (char *) 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.
      */
 
-    memcpy(dsPtr->string + dsPtr->length, bytes, length);
+    for (dst = dsPtr->string + dsPtr->length, end = string+length;
+	    string < end; string++, dst++) {
+	*dst = *string;
+    }
+    *dst = '\0';
     dsPtr->length += length;
-    dsPtr->string[dsPtr->length] = '\0';
     return dsPtr->string;
 }
 
@@ -2446,66 +1549,62 @@ Tcl_DStringAppend(
  *	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(
-    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
-    const char *element)	/* String to append. Must be
+Tcl_DStringAppendElement(dsPtr, string)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    CONST char *string;		/* String to append.  Must be
 				 * null-terminated. */
 {
-    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);
+    int newSize, flags, strSize;
+    char *dst;
+
+    strSize = ((string == NULL) ? 0 : strlen(string));
+    newSize = Tcl_ScanCountedElement(string, strSize, &flags)
+	+ dsPtr->length + 1;
 
     /*
-     * 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 = ckalloc(dsPtr->spaceAvl);
+	    char *newString;
 
-	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
+	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+	    memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		    (size_t) dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
+	    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.
      */
 
-    if (needSpace) {
+    dst = dsPtr->string + dsPtr->length;
+    if (TclNeedSpace(dsPtr->string, dst)) {
 	*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 += TclConvertElement(element, -1, dst, flags);
-    dsPtr->string[dsPtr->length] = '\0';
+    dsPtr->length += Tcl_ConvertCountedElement(string, strSize, dst, flags);
     return dsPtr->string;
 }
 
@@ -2514,24 +1613,25 @@ Tcl_DStringAppendElement(
  *
  * 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(
-    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
-    int length)			/* New length for dynamic string. */
+Tcl_DStringSetLength(dsPtr, length)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
+    int length;			/* New length for dynamic string. */
 {
     int newsize;
 
@@ -2540,15 +1640,15 @@ Tcl_DStringSetLength(
     }
     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;
@@ -2558,12 +1658,15 @@ Tcl_DStringSetLength(
 	    dsPtr->spaceAvl = length + 1;
 	}
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString = ckalloc(dsPtr->spaceAvl);
+	    char *newString;
 
-	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
+	    newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
+	    memcpy((VOID *) newString, (VOID *) dsPtr->string,
+		    (size_t) dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
-	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
+	    dsPtr->string = (char *) ckrealloc((VOID *) dsPtr->string,
+		    (size_t) dsPtr->spaceAvl);
 	}
     }
     dsPtr->length = length;
@@ -2575,22 +1678,21 @@ Tcl_DStringSetLength(
  *
  * 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(
-    Tcl_DString *dsPtr)		/* Structure describing dynamic string. */
+Tcl_DStringFree(dsPtr)
+    Tcl_DString *dsPtr;		/* Structure describing dynamic string. */
 {
     if (dsPtr->string != dsPtr->staticSpace) {
 	ckfree(dsPtr->string);
@@ -2606,40 +1708,39 @@ Tcl_DStringFree(
  *
  * Tcl_DStringResult --
  *
- *	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.
+ *	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.
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
-    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
+Tcl_DStringResult(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. */
 {
-    Interp *iPtr = (Interp *) interp;
-
     Tcl_ResetResult(interp);
-
+    
     if (dsPtr->string != dsPtr->staticSpace) {
-	iPtr->result = dsPtr->string;
-	iPtr->freeProc = TCL_DYNAMIC;
+	interp->result = dsPtr->string;
+	interp->freeProc = TCL_DYNAMIC;
     } else if (dsPtr->length < TCL_RESULT_SIZE) {
-	iPtr->result = iPtr->resultSpace;
-	memcpy(iPtr->result, dsPtr->string, dsPtr->length + 1);
+	interp->result = ((Interp *) interp)->resultSpace;
+	strcpy(interp->result, dsPtr->string);
     } else {
 	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
     }
-
+    
     dsPtr->string = dsPtr->staticSpace;
     dsPtr->length = 0;
     dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
@@ -2651,14 +1752,14 @@ Tcl_DStringResult(
  *
  * Tcl_DStringGetResult --
  *
- *	This function moves an interpreter's result into a dynamic string.
+ *	This procedure 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.
@@ -2667,23 +1768,26 @@ Tcl_DStringResult(
  */
 
 void
-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. */
+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. */
 {
     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.
      */
 
-    (void) Tcl_GetStringResult(interp);
+    if (*(iPtr->result) == 0) {
+	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+	        TCL_VOLATILE);
+    }
 
     dsPtr->length = strlen(iPtr->result);
     if (iPtr->freeProc != NULL) {
@@ -2691,9 +1795,9 @@ Tcl_DStringGetResult(
 	    dsPtr->string = iPtr->result;
 	    dsPtr->spaceAvl = dsPtr->length+1;
 	} else {
-	    dsPtr->string = ckalloc(dsPtr->length+1);
-	    memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
-	    iPtr->freeProc(iPtr->result);
+	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
+	    strcpy(dsPtr->string, iPtr->result);
+	    (*iPtr->freeProc)(iPtr->result);
 	}
 	dsPtr->spaceAvl = dsPtr->length+1;
 	iPtr->freeProc = NULL;
@@ -2702,12 +1806,12 @@ Tcl_DStringGetResult(
 	    dsPtr->string = dsPtr->staticSpace;
 	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
 	} else {
-	    dsPtr->string = ckalloc(dsPtr->length+1);
+	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
 	    dsPtr->spaceAvl = dsPtr->length + 1;
 	}
-	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
+	strcpy(dsPtr->string, iPtr->result);
     }
-
+    
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
 }
@@ -2715,69 +1819,11 @@ Tcl_DStringGetResult(
 /*
  *----------------------------------------------------------------------
  *
- * TclDStringToObj --
- *
- *	This function moves a dynamic string's contents to a new Tcl_Obj. Be
- *	aware that this function does *not* check that the encoding of the
- *	contents of the dynamic string is correct; this is the caller's
- *	responsibility to enforce.
- *
- * Results:
- *	The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
- *	reference count of zero.
- *
- * Side effects:
- *	The string is "moved" to the object. dsPtr is reinitialized to an
- *	empty string; it does not need to be Tcl_DStringFree'd after this if
- *	not used further.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-TclDStringToObj(
-    Tcl_DString *dsPtr)
-{
-    Tcl_Obj *result;
-
-    if (dsPtr->length == 0) {
-	TclNewObj(result);
-    } else if (dsPtr->string == dsPtr->staticSpace) {
-	/*
-	 * Static buffer, so must copy.
-	 */
-
-	TclNewStringObj(result, dsPtr->string, dsPtr->length);
-    } else {
-	/*
-	 * Dynamic buffer, so transfer ownership and reset.
-	 */
-
-	TclNewObj(result);
-	result->bytes = dsPtr->string;
-	result->length = dsPtr->length;
-    }
-
-    /*
-     * Re-establish the DString as empty with no buffer allocated.
-     */
-
-    dsPtr->string = dsPtr->staticSpace;
-    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
-    dsPtr->length = 0;
-    dsPtr->staticSpace[0] = '\0';
-
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * Tcl_DStringStartSublist --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -2789,8 +1835,8 @@ TclDStringToObj(
  */
 
 void
-Tcl_DStringStartSublist(
-    Tcl_DString *dsPtr)		/* Dynamic string. */
+Tcl_DStringStartSublist(dsPtr)
+    Tcl_DString *dsPtr;			/* Dynamic string. */
 {
     if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
 	Tcl_DStringAppend(dsPtr, " {", -1);
@@ -2804,9 +1850,10 @@ Tcl_DStringStartSublist(
  *
  * Tcl_DStringEndSublist --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
@@ -2818,8 +1865,8 @@ Tcl_DStringStartSublist(
  */
 
 void
-Tcl_DStringEndSublist(
-    Tcl_DString *dsPtr)		/* Dynamic string. */
+Tcl_DStringEndSublist(dsPtr)
+    Tcl_DString *dsPtr;			/* Dynamic string. */
 {
     Tcl_DStringAppend(dsPtr, "}", -1);
 }
@@ -2829,14 +1876,14 @@ Tcl_DStringEndSublist(
  *
  * Tcl_PrintDouble --
  *
- *	Given a floating-point value, this function converts it to an ASCII
- *	string using.
+ *	Given a floating-point value, this procedure 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.
@@ -2845,159 +1892,43 @@ Tcl_DStringEndSublist(
  */
 
 void
-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. */
+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. */
 {
     char *p, c;
-    int exponent;
-    int signum;
-    char *digits;
-    char *end;
-    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
+    Tcl_UniChar ch;
 
-    /*
-     * Handle NaN.
-     */
-    
-    if (TclIsNaN(value)) {
-	TclFormatNaN(value, dst);
-	return;
-    }
+    Tcl_MutexLock(&precisionMutex);
+    sprintf(dst, precisionFormat, value);
+    Tcl_MutexUnlock(&precisionMutex);
 
     /*
-     * Handle infinities.
+     * 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.
      */
-    
-    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);
+    for (p = dst; *p != 0; ) {
+	if (UCHAR(*p) < 0x80) {
+	    c = *p++;
 	} 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';
-	    }
+	    p += Tcl_UtfToUniChar(p, &ch);
+	    c = UCHAR(ch);
 	}
-	*dst++ = '.';
-	if (c == '\0') {
-	    *dst++ = '0';
-	} else {
-	    while (++exponent < -1) {
-		*dst++ = '0';
-	    }
-	    while (c != '\0') {
-		*dst++ = c;
-		c = *++p;
-	    }
+	if ((c == '.') || isalpha(UCHAR(c))) {	/* INTL: ISO only. */
+	    return;
 	}
-	*dst++ = '\0';
     }
-    ckfree(digits);
+    p[0] = '.';
+    p[1] = '0';
+    p[2] = 0;
 }
 
 /*
@@ -3005,33 +1936,33 @@ Tcl_PrintDouble(
  *
  * TclPrecTraceProc --
  *
- *	This function is invoked whenever the variable "tcl_precision" is
- *	written.
+ *	This procedure 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 function 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 procedure
+ *	undoes the effect of the variable modification.  Otherwise
+ *	it modifies the format string that's used by Tcl_PrintDouble.
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
 char *
-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. */
+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. */
 {
-    Tcl_Obj *value;
+    CONST char *value;
+    char *end;
     int prec;
-    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
 
     /*
      * If the variable is unset, then recreate the trace.
@@ -3043,39 +1974,54 @@ TclPrecTraceProc(
 		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
 		    |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
 	}
-	return NULL;
+	return (char *) 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_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr),
+	Tcl_SetVar2(interp, name1, name2, precisionString,
 		flags & TCL_GLOBAL_ONLY);
-	return NULL;
+	Tcl_MutexUnlock(&precisionMutex);
+	return (char *) 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)) {
-	return (char *) "can't modify precision from a safe interpreter";
+	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 = "";
     }
-    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
-    if (value == NULL
-	    || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
-	    || prec < 0 || prec > TCL_MAX_PREC) {
-	return (char *) "improper value for precision";
+    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);
+	return "improper value for precision";
     }
-    *precisionPtr = prec;
-    return NULL;
+    TclFormatInt(precisionString, prec);
+    sprintf(precisionFormat, "%%.%dg", prec);
+    Tcl_MutexUnlock(&precisionMutex);
+    return (char *) NULL;
 }
 
 /*
@@ -3083,8 +2029,9 @@ TclPrecTraceProc(
  *
  * TclNeedSpace --
  *
- *	This function checks to see whether it is appropriate to add a space
- *	before appending a new list element to an existing string.
+ *	This procedure 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.
@@ -3096,25 +2043,24 @@ TclPrecTraceProc(
  */
 
 int
-TclNeedSpace(
-    const char *start,		/* First character in string. */
-    const char *end)		/* End of string (place where space will be
-				 * added, if appropriate). */
+TclNeedSpace(start, end)
+    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);
@@ -3127,40 +2073,39 @@ TclNeedSpace(
 
     /*
      * (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;
 }
@@ -3173,19 +2118,17 @@ TclNeedSpace(
  *	This procedure formats an integer into a sequence of decimal digit
  *	characters in a buffer. If the integer is negative, a minus sign is
  *	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, "%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).
+ *	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.
  *
  * Results:
  *	An integer representing the number of characters formatted, not
  *	including the terminating \0.
  *
  * Side effects:
- *	The formatted characters are written into the storage pointer to by
- *	the "buffer" argument.
+ *	The formatted characters are written into the storage pointer to
+ *	by the "buffer" argument.
  *
  *----------------------------------------------------------------------
  */
@@ -3199,7 +2142,7 @@ TclFormatInt(buffer, n)
     long intVal;
     int i;
     int numFormatted, j;
-    const char *digits = "0123456789";
+    char *digits = "0123456789";
 
     /*
      * Check first whether "n" is zero.
@@ -3219,7 +2162,8 @@ TclFormatInt(buffer, n)
 
     intVal = -n;			/* [Bug 3390638] Workaround for*/
     if (n == -n || intVal == n) {	/* broken compiler optimizers. */
-	return sprintf(buffer, "%ld", n);
+	sprintf(buffer, "%ld", n);
+	return strlen(buffer);
     }
 
     /*
@@ -3255,120 +2199,133 @@ 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 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)?.
+ *	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)?". 
  *
  * 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 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.
+ *	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.
  *
  * 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(
-    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(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
 				 * "objPtr" holds "end". */
-    int *indexPtr)		/* Location filled in with an integer
+    int *indexPtr;		/* Location filled in with an integer
 				 * representing an index. */
 {
-    int length;
-    char *opPtr;
-    const char *bytes;
-
-    if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
+    if (Tcl_GetIntFromObj(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) {
+    } else {
 	/*
-	 * 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.
+	 * Report a parse error.
 	 */
 
-	bytes = Tcl_GetString(objPtr);
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "bad index \"", bytes,
-		"\": must be integer?[+-]integer? or end?[+-]integer?", NULL);
-	if (!strncmp(bytes, "end-", 4)) {
-	    bytes += 4;
+	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);
 	}
-	TclCheckBadOctal(interp, bytes);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
-    }
 
-    return TCL_ERROR;
+	return TCL_ERROR;
+    }
+	    
+    return TCL_OK;
 }
 
 /*
@@ -3385,27 +2342,28 @@ TclGetIntForIndex(
  * Side effects:
  *	Stores a valid string in the object's string rep.
  *
- * 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.
+ * 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.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UpdateStringOfEndOffset(
-    register Tcl_Obj *objPtr)
+UpdateStringOfEndOffset(objPtr)
+    register Tcl_Obj* objPtr;
 {
     char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
     register int len;
 
-    memcpy(buffer, "end", sizeof("end") + 1);
+    strcpy(buffer, "end");
     len = sizeof("end") - 1;
     if (objPtr->internalRep.longValue != 0) {
 	buffer[len++] = '-';
 	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
     }
-    objPtr->bytes = ckalloc((unsigned) len+1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len+1);
+    objPtr->bytes = ckalloc((unsigned) (len+1));
+    strcpy(objPtr->bytes, buffer);
     objPtr->length = len;
 }
 
@@ -3414,107 +2372,100 @@ UpdateStringOfEndOffset(
  *
  * 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(
-    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
-    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
+SetEndOffsetFromAny(interp, objPtr)
+     Tcl_Interp* interp;	/* Tcl interpreter or NULL */
+     Tcl_Obj* objPtr;		/* Pointer to the object to parse */
 {
     int offset;			/* Offset in the "end-offset" expression */
-    register const char *bytes;	/* String rep of the object */
+    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 = TclGetStringFromObj(objPtr, &length);
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
     if ((*bytes != 'e') || (strncmp(bytes, "end",
 	    (size_t)((length > 3) ? 3 : length)) != 0)) {
 	if (interp != NULL) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "bad index \"", bytes,
-		    "\": must be end?[+-]integer?", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+				   "bad index \"", bytes,
+				   "\": must be end?-integer?",
+				   (char*) NULL);
 	}
 	return TCL_ERROR;
     }
 
-    /*
-     * Convert the string rep.
-     */
+    /* Convert the string rep */
 
     if (length <= 3) {
 	offset = 0;
-    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
+    } else if ((length > 4) && (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])) {
-	    goto badIndexFormat;
-	}
 	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (bytes[3] == '-') {
-	    offset = -offset;
-	}
+	offset = -offset;
     } else {
 	/*
-	 * Conversion failed. Report the error.
+	 * Conversion failed.  Report the error.
 	 */
-
-    badIndexFormat:
 	if (interp != NULL) {
 	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "bad index \"", bytes,
-		    "\": must be end?[+-]integer?", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+				   "bad index \"", bytes,
+				   "\": must be integer or end?-integer?",
+				   (char *) 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.
      */
 
-    TclFreeIntRep(objPtr);
+    if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
+	oldTypePtr->freeIntRepProc(objPtr);
+    }
+    
     objPtr->internalRep.longValue = offset;
     objPtr->typePtr = &tclEndOffsetType;
 
     return TCL_OK;
-}
+}    
 
 /*
  *----------------------------------------------------------------------
  *
  * TclCheckBadOctal --
  *
- *	This function checks for a bad octal value and appends a meaningful
- *	error to the interp's result.
+ *	This procedure 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.
@@ -3526,48 +2477,41 @@ SetEndOffsetFromAny(
  */
 
 int
-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. */
+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. */
 {
-    register const char *p = value;
+    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 (TclIsSpaceProc(*p)) {
+    while (isspace(UCHAR(*p))) {	/* INTL: ISO space. */
 	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 (TclIsSpaceProc(*p)) {
+	while (isspace(UCHAR(*p))) {	/* INTL: ISO space. */
 	    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)",
-			NULL);
+			(char *) NULL);
 	    }
 	    return 1;
 	}
@@ -3578,351 +2522,28 @@ TclCheckBadOctal(
 /*
  *----------------------------------------------------------------------
  *
- * 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_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_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));
-
-    if (NULL == *tablePtrPtr) {
-	*tablePtrPtr = ckalloc(sizeof(Tcl_HashTable));
-	Tcl_CreateThreadExitHandler(FreeThreadHash, *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 = clientData;
-
-    ClearHash(tablePtr);
-    Tcl_DeleteHashTable(tablePtr);
-    ckfree(tablePtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FreeProcessGlobalValue --
- *
- *	Exit handler used by Tcl(Set|Get)ProcessGlobalValue to cleanup a
- *	ProcessGlobalValue at exit.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FreeProcessGlobalValue(
-    ClientData clientData)
-{
-    ProcessGlobalValue *pgvPtr = 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(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, INT2PTR(pgvPtr->epoch), &dummy);
-    Tcl_SetHashValue(hPtr, 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(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, pgvPtr);
-	}
-
-	/*
-	 * Store a copy of the shared value in our epoch-indexed cache.
-	 */
-
-	value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
-	hPtr = Tcl_CreateHashEntry(cacheMap,
-		INT2PTR(pgvPtr->epoch), &dummy);
-	Tcl_MutexUnlock(&pgvPtr->mutex);
-	Tcl_SetHashValue(hPtr, value);
-	Tcl_IncrRefCount(value);
-    }
-    return 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 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.
+ *	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.
  *
  * 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:
- *	None.
+ *	The object referenced by "objPtr" might be converted to an
+ *	integer object.
  *
  *----------------------------------------------------------------------
  */
 
-const char *
-Tcl_GetNameOfExecutable(void)
+CONST char *
+Tcl_GetNameOfExecutable()
 {
-    int numBytes;
-    const char *bytes =
-	    Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);
-
-    if (numBytes == 0) {
-	return NULL;
-    }
-    return bytes;
+    return tclExecutableName;
 }
 
 /*
@@ -3930,9 +2551,7 @@ Tcl_GetNameOfExecutable(void)
  *
  * TclpGetTime --
  *
- *	Deprecated synonym for Tcl_GetTime. This function is provided for the
- *	benefit of extensions written before Tcl_GetTime was exported from the
- *	library.
+ *	Deprecated synonym for Tcl_GetTime.
  *
  * Results:
  *	None.
@@ -3940,260 +2559,15 @@ Tcl_GetNameOfExecutable(void)
  * 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(
-    Tcl_Time *timePtr)
+TclpGetTime(timePtr)
+    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;
-    const char *msg, *p, *strEnd, *code;
-
-    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, 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;
-    code = 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";
-		code = "BADESCAPE";
-		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";
-		code = "NONANCHOR";
-		goto invalidGlob;
-	    }
-	    anchorRight = 1;
-	    break;
-	case '*': case '+': case '?': case '|': case '^':
-	case '{': case '}': case '(': case ')': case '[': case ']':
-	    msg = "unhandled RE special char";
-	    code = "UNHANDLED";
-	    goto invalidGlob;
-	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";
-	code = "OVERCOMPLEX";
-	goto invalidGlob;
-    }
-
-    if (!anchorRight && !lastIsStar) {
-	*dsStr++ = '*';
-    }
-    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);
-
-    if (exactPtr) {
-	*exactPtr = (anchorLeft && anchorRight);
-    }
-
-    return TCL_OK;
-
-  invalidGlob:
-    if (interp != NULL) {
-	Tcl_AppendResult(interp, msg, NULL);
-	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, 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 e92dc5f..c029877 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,326 +10,147 @@
  * 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) 2007 Miguel Sofer
+ * 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 "tclOOInt.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 const Tcl_HashKeyType tclVarHashKeyType = {
-    TCL_HASH_KEY_TYPE_VERSION,	/* version */
-    0,				/* flags */
-    TclHashObjKey,		/* 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)))
-
-static inline Var *
-VarHashCreateVar(
-    TclVarHashTable *tablePtr,
-    Tcl_Obj *key,
-    int *newPtr)
-{
-    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
-	    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(&(tablePtr)->table, (searchPtr))
-
-#define VarHashNextEntry(searchPtr) \
-    Tcl_NextHashEntry((searchPtr))
+#include "tclPort.h"
 
-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(&(tablePtr)->table)
 
 /*
- * 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";
 
 /*
- * 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.
+ * Forward references to procedures defined later in this file:
  */
 
-#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)
+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));
 
 /*
- * Forward references to functions defined later in this file:
+ * 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.
  */
 
-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, int index);
-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, int index);
-static int		SetArraySearchObj(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
-
-/*
- * 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.
- */
+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));
 
-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;
+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;
 
 /*
  * Types of Tcl_Objs used to cache variable lookups.
  *
+ * 
  * localVarName - INTERNALREP DEFINITION:
- *   ptrAndLongRep.ptr:   pointer to name obj in varFramePtr->localCache
- *			  or NULL if it is this same obj
- *   ptrAndLongRep.value: index into locals table
+ *   twoPtrValue.ptr1 = pointer to the corresponding Proc 
+ *   twoPtrValue.ptr2 = 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 const Tcl_ObjType localVarNameType = {
+static Tcl_ObjType tclLocalVarNameType = {
     "localVarName",
-    FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
+    FreeLocalVarName, DupLocalVarName, UpdateLocalVarName, NULL
 };
 
-/*
- * 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 const Tcl_ObjType tclNsVarNameType = {
+static Tcl_ObjType tclNsVarNameType = {
     "namespaceVarName",
-    FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName
+    FreeNsVarName, DupNsVarName, NULL, NULL
 };
-#endif
 
-static const Tcl_ObjType tclParsedVarNameType = {
+static Tcl_ObjType tclParsedVarNameType = {
     "parsedVarName",
-    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
+    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, NULL
 };
 
 /*
  * Type of Tcl_Objs used to speed up array searches.
  *
  * INTERNALREP DEFINITION:
- *   twoPtrValue.ptr1:	searchIdNumber (cast to pointer)
- *   twoPtrValue.ptr2:	variableNameStartInString (cast to pointer)
+ *   twoPtrValue.ptr1 = searchIdNumber as offset from (char*)NULL
+ *   twoPtrValue.ptr2 = variableNameStartInString as offset from (char*)NULL
  *
- * 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.
  */
-
-const Tcl_ObjType tclArraySearchType = {
+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(varPtr);
-	} else {
-	    VarHashDeleteEntry(varPtr);
-	}
-    }
-    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
-	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
-	    (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
-	if (VarHashRefCount(arrayPtr) == 0) {
-	    ckfree(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 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.
+ *	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. 
  *
  * Results:
  *	The return value is a pointer to the variable structure indicated by
@@ -343,14 +164,14 @@ TclCleanupVar(
  *
  *	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
@@ -358,58 +179,132 @@ TclCleanupVar(
  *
  *----------------------------------------------------------------------
  */
-
 Var *
-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,
+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,
 				 * 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. */
 {
-    Tcl_Obj *part1Ptr;
     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;
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
+    varPtr = NULL;
+    *arrayPtrPtr = NULL;
+    openParen = closeParen = -1;
 
-    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, msg,
-	    createPart1, createPart2, arrayPtrPtr);
+    /*
+     * 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;
+    }
+
+    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);
+    }
 
-    TclDecrRefCount(part1Ptr);
     return varPtr;
+	
+#undef VAR_NAME_BUF_SIZE
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclObjLookupVar, TclObjLookupVarEx --
+ * TclObjLookupVar --
  *
- *	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.
+ *	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.
  *
  * 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
@@ -418,277 +313,201 @@ TclLookupVar(
  *
  *	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 localVarNameType,
- *	tclNsVarNameType or tclParsedVarNameType and caches as much of the
- *	lookup as it can.
+ *	are 1.
+ *      The object part1Ptr is converted to one of tclLocalVarNameType, 
+ *      tclNsVarNameType or tclParsedVarNameType and caches as much of the
+ *      lookup as it can.
  *
  *----------------------------------------------------------------------
  */
-
 Var *
-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
+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 
 				 * 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
+    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;
-    Var *resPtr;
-
-    if (part2) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
-    }
-
-    resPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr,
-	    flags, msg, createPart1, createPart2, arrayPtrPtr);
-
-    if (part2Ptr) {
-	Tcl_DecrRefCount(part2Ptr);
-    }
-
-    return resPtr;
-}
-
-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
-				 * 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
 				 * structure. */
-    const char *part1;
+    char *part1;
     int index, len1, len2;
     int parsed = 0;
     Tcl_Obj *objPtr;
-    const Tcl_ObjType *typePtr = part1Ptr->typePtr;
-    const char *errMsg = NULL;
+    Tcl_ObjType *typePtr = part1Ptr->typePtr;
+    CONST char *errMsg = NULL;
     CallFrame *varFramePtr = iPtr->varFramePtr;
-#if ENABLE_NS_VARNAME_CACHING
     Namespace *nsPtr;
-#endif
-    const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
-    char *newPart2 = NULL;
 
-    *arrayPtrPtr = NULL;
+    /*
+     * If part1Ptr is a tclParsedVarNameType, separate it into the 
+     * pre-parsed parts.
+     */
 
-#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.
-	 */
+    *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.
+		 */
 
-	nsPtr = NULL;
+		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;
     }
-#endif
+    part1 = Tcl_GetStringFromObj(part1Ptr, &len1);    
 
-    if (typePtr == &localVarNameType) {
-	int localIndex;
+    nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr);
+    if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
+	goto doParse;
+    }
+    
+    if (typePtr == &tclLocalVarNameType) {
+	Proc *procPtr = (Proc *) part1Ptr->internalRep.twoPtrValue.ptr1;
+	int localIndex = (int) part1Ptr->internalRep.twoPtrValue.ptr2;
+	int useLocal;
 
-    localVarNameTypeHandling:
-	localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
-	if (HasLocalVars(varFramePtr)
-		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
-		&& (localIndex < varFramePtr->numCompiledLocals)) {
+	useLocal = ((varFramePtr != NULL) && varFramePtr->isProcCallFrame
+	        && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)));
+	if (useLocal && (procPtr == varFramePtr->procPtr)) {
 	    /*
-	     * Use the cached index if the names coincide.
+	     * part1Ptr points to an indexed local variable of the
+	     * correct procedure: use the cached value.
 	     */
-
-	    Tcl_Obj *namePtr = 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;
-	    }
+	    
+	    varPtr = &(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)));
-
-	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)) {
+	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)) {
 	    /*
-	     * 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 TclIsVarDeadHash(varPtr), this might be a reference to a
+	     * If (varPtr->hPtr == NULL), 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);
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
-		}
-		return NULL;
-	    }
-	    part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
-	    if (newPart2) {
-		part2Ptr = Tcl_NewStringObj(newPart2, -1);
-		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 (part2Ptr != NULL) {
+		if (part2 != NULL) {
 		    if (flags & TCL_LEAVE_ERR_MSG) {
-			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
-				needArray, -1);
-			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
-				NULL);
+			VarErrMsg(interp, part1, part2, msg, needArray);
 		    }
-		    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;
 		len2 = len1 - i - 2;
 		len1 = i;
 
-		newPart2 = ckalloc(len2 + 1);
-		memcpy(newPart2, part2, (unsigned) len2);
+		newPart2 = ckalloc((unsigned int) (len2+1));
+		memcpy(newPart2, part2, (unsigned int) len2);
 		*(newPart2+len2) = '\0';
 		part2 = newPart2;
-		part2Ptr = Tcl_NewStringObj(newPart2, -1);
-		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;
-		TclFreeIntRep(objPtr);
+		if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+		    typePtr->freeIntRepProc(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.
 		 */
 
-		TclNewStringObj(part1Ptr, part1, len1);
+		part1Ptr = Tcl_NewStringObj(part1, len1);
 		Tcl_IncrRefCount(part1Ptr);
 
-		objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
-		objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;
+		objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) part1Ptr;
+		objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) part2;		
 
 		typePtr = part1Ptr->typePtr;
 		part1 = TclGetString(part1Ptr);
@@ -696,25 +515,23 @@ TclObjLookupVarEx(
 	    }
 	}
     }
-
-  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.
      */
 
-    TclFreeIntRep(part1Ptr);
+    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
+	typePtr->freeIntRepProc(part1Ptr);
+	part1Ptr->typePtr = NULL;
+    }
 
-    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
-	    &errMsg, &index);
+    varPtr = TclLookupSimpleVar(interp, part1, flags, 
+            createPart1, &errMsg, &index);
     if (varPtr == NULL) {
 	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
-	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-		    TclGetString(part1Ptr), NULL);
-	}
-	if (newPart2) {
-	    Tcl_DecrRefCount(part2Ptr);
+	    VarErrMsg(interp, part1, part2, msg, errMsg);
 	}
 	return NULL;
     }
@@ -724,53 +541,52 @@ TclObjLookupVarEx(
      */
 
     if (index >= 0) {
-	/*
+        /*
 	 * An indexed local variable.
 	 */
 
-	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
+	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
+     */
+
     } 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 = nsPtr;
-	part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr;
+	part1Ptr->internalRep.twoPtrValue.ptr1 = (VOID *) nsPtr;
+	part1Ptr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
 #endif
     } else {
 	/*
 	 * At least mark part1Ptr as already parsed.
 	 */
-
 	part1Ptr->typePtr = &tclParsedVarNameType;
 	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
 	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
     }
-
-  donePart1:
-#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
+    
+    donePart1:
+#if 0
     if (varPtr == NULL) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    part1 = TclGetString(part1Ptr);
-	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
-		    "cached variable reference is NULL.", -1);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-		    TclGetString(part1Ptr), NULL);
+	    VarErrMsg(interp, part1, part2, msg, 
+		    "Cached variable reference is NULL.");
 	}
 	return NULL;
     }
@@ -779,71 +595,63 @@ TclObjLookupVarEx(
 	varPtr = varPtr->value.linkPtr;
     }
 
-    if (part2Ptr != NULL) {
+    if (part2 != NULL) {
 	/*
 	 * Array element sought: look it up.
 	 */
 
+	part1 = TclGetString(part1Ptr);
 	*arrayPtrPtr = varPtr;
-	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
-		createPart1, createPart2, varPtr, -1);
-	if (newPart2) {
-	    Tcl_DecrRefCount(part2Ptr);
-	}
+	varPtr = TclLookupArrayElement(interp, part1, part2, 
+                flags, msg, createPart1, createPart2, varPtr);
     }
     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
- *
- * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
- * (Bug #835020)
+ * 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
  */
-
-#define AVOID_RESOLVERS 0x40000
+#define LOOKUP_FOR_UPVAR 0x40000
 
 /*
  *----------------------------------------------------------------------
  *
  * TclLookupSimpleVar --
  *
- *	This function is used by to locate a simple variable (i.e., not an
- *	array element) given its name.
+ *	This procedure 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.
@@ -852,191 +660,206 @@ TclObjLookupVarEx(
  */
 
 Var *
-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
+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 
 				 * 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. */
-    TclVarHashTable *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. */
+    Tcl_HashTable *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;
-    int isNew, i, result, varLen;
-    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);
+    Tcl_HashEntry *hPtr;
+    int new, i, result;
 
     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) {
-	cxtNsPtr = iPtr->globalNsPtr;
+    if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) {
+        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 & AVOID_RESOLVERS)) {
-	resPtr = iPtr->resolverPtr;
-	if (cxtNsPtr->varResProc) {
-	    result = cxtNsPtr->varResProc(interp, varName,
+    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) 
+	    && !(flags & LOOKUP_FOR_UPVAR)) {
+        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) {
-	    return (Var *) var;
-	} else if (result != TCL_CONTINUE) {
+            }
+            resPtr = resPtr->nextPtr;
+        }
+
+        if (result == TCL_OK) {
+            varPtr = (Var *) var;
+	    return varPtr;
+        } 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)
-	    || !HasLocalVars(varFramePtr)
+	    || (varFramePtr == NULL)
+	    || !varFramePtr->isProcCallFrame
 	    || (strstr(varName, "::") != NULL)) {
-	const char *tail;
-	int lookGlobal = (flags & TCL_GLOBAL_ONLY)
-		|| (cxtNsPtr == iPtr->globalNsPtr)
-		|| ((*varName == ':') && (*(varName+1) == ':'));
-
+	CONST char *tail;
+	int lookGlobal;
+	
+	lookGlobal = (flags & TCL_GLOBAL_ONLY) 
+	    || (cxtNsPtr == iPtr->globalNsPtr)
+	    || ((*varName == ':') && (*(varName+1) == ':'));
 	if (lookGlobal) {
 	    *indexPtr = -1;
-	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
+	    flags = (flags | TCL_GLOBAL_ONLY) & ~(TCL_NAMESPACE_ONLY|LOOKUP_FOR_UPVAR);
 	} else {
-	    if (flags & AVOID_RESOLVERS) {
-		flags = (flags | TCL_NAMESPACE_ONLY);
+	    if (flags & LOOKUP_FOR_UPVAR) {
+		flags = (flags | TCL_NAMESPACE_ONLY) & ~LOOKUP_FOR_UPVAR;
 	    }
 	    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!
 	 */
-
-	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
-		(Tcl_Namespace *) cxtNsPtr,
-		(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
+	var = Tcl_FindNamespaceVar(interp, varName, (Tcl_Namespace *) cxtNsPtr,
+		flags & ~TCL_LEAVE_ERR_MSG);
+	if (var != (Tcl_Var) NULL) {
+            varPtr = (Var *) var;
+        }
 	if (varPtr == NULL) {
-	    Tcl_Obj *tailPtr;
-
-	    if (create) {	/* Var wasn't found so create it. */
+	    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;
-		} else if (tail == NULL) {
+		}
+		if (tail == NULL) {
 		    *errMsgPtr = missingName;
 		    return NULL;
 		}
-		if (tail != varName) {
-		    tailPtr = Tcl_NewStringObj(tail, -1);
-		} else {
-		    tailPtr = varNamePtr;
-		}
-		varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr,
-			&isNew);
-		if (lookGlobal) {
+		hPtr = Tcl_CreateHashEntry(&varNsPtr->varTable, tail, &new);
+		varPtr = NewVar();
+		Tcl_SetHashValue(hPtr, varPtr);
+		varPtr->hPtr = hPtr;
+		varPtr->nsPtr = varNsPtr;
+		if ((lookGlobal)  || (varNsPtr == NULL)) {
 		    /*
 		     * 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. */
-	int localLen, localCt = varFramePtr->numCompiledLocals;
-	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
-	const char *localNameStr;
-
-	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
-	    register Tcl_Obj *objPtr = *objPtrPtr;
-
-	    if (objPtr) {
-		localNameStr = TclGetStringFromObj(objPtr, &localLen);
-
-		if ((varLen == localLen) && (varName[0] == localNameStr[0])
-			&& !memcmp(varName, localNameStr, varLen)) {
+    } 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;
+		if ((varName[0] == localName[0])
+		        && (varNameLen == localPtr->nameLength)
+		        && (strcmp(varName, localName) == 0)) {
 		    *indexPtr = i;
-		    return (Var *) &varFramePtr->compiledLocals[i];
+		    return localVarPtr;
 		}
 	    }
+	    localVarPtr++;
+	    localPtr = localPtr->nextPtr;
 	}
 	tablePtr = varFramePtr->varTablePtr;
 	if (create) {
 	    if (tablePtr == NULL) {
-		tablePtr = ckalloc(sizeof(TclVarHashTable));
-		TclInitVarHashTable(tablePtr, NULL);
+		tablePtr = (Tcl_HashTable *)
+		    ckalloc(sizeof(Tcl_HashTable));
+		Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
 		varFramePtr->varTablePtr = tablePtr;
 	    }
-	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
+	    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);
+	    }
 	} else {
-	    varPtr = NULL;
+	    hPtr = NULL;
 	    if (tablePtr != NULL) {
-		varPtr = VarHashFindVar(tablePtr, varNamePtr);
+		hPtr = Tcl_FindHashEntry(tablePtr, varName);
 	    }
-	    if (varPtr == NULL) {
+	    if (hPtr == NULL) {
 		*errMsgPtr = noSuchVar;
+		return NULL;
 	    }
+	    varPtr = (Var *) Tcl_GetHashValue(hPtr);
 	}
     }
     return varPtr;
@@ -1047,75 +870,69 @@ TclLookupSimpleVar(
  *
  * TclLookupArrayElement --
  *
- *	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.
+ *	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.
  *
  * 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.
  *
  *----------------------------------------------------------------------
  */
 
 Var *
-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. */
+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. */
 {
-    int isNew;
+    Tcl_HashEntry *hPtr;
+    int new;
     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) {
-		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
-			noSuchVar, index);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
+		VarErrMsg(interp, arrayName, elName, msg, noSuchVar);
 	    }
 	    return NULL;
 	}
@@ -1124,58 +941,47 @@ TclLookupArrayElement(
 	 * Make sure we are not resurrecting a namespace variable from a
 	 * deleted namespace!
 	 */
-
-	if (TclIsVarDeadHash(arrayPtr)) {
+	if ((arrayPtr->flags & VAR_IN_HASHTABLE) && (arrayPtr->hPtr == NULL)) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
-			danglingVar, index);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
+		VarErrMsg(interp, arrayName, elName, msg, danglingVar);
 	    }
 	    return NULL;
 	}
 
 	TclSetVarArray(arrayPtr);
-	tablePtr = ckalloc(sizeof(TclVarHashTable));
-	arrayPtr->value.tablePtr = tablePtr;
-
-	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
-	    nsPtr = TclGetVarNsPtr(arrayPtr);
-	} else {
-	    nsPtr = NULL;
-	}
-	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
+	TclClearVarUndefined(arrayPtr);
+	arrayPtr->value.tablePtr =
+	    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(arrayPtr->value.tablePtr, TCL_STRING_KEYS);
     } else if (!TclIsVarArray(arrayPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
-		    index);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
+	    VarErrMsg(interp, arrayName, elName, msg, needArray);
 	}
 	return NULL;
     }
 
     if (createElem) {
-	varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr,
-		&isNew);
-	if (isNew) {
-	    if (arrayPtr->flags & VAR_SEARCH_ACTIVE) {
-		DeleteSearches((Interp *) interp, arrayPtr);
+	hPtr = Tcl_CreateHashEntry(arrayPtr->value.tablePtr, elName, &new);
+	if (new) {
+	    if (arrayPtr->searchPtr != NULL) {
+		DeleteSearches(arrayPtr);
 	    }
+	    varPtr = NewVar();
+	    Tcl_SetHashValue(hPtr, varPtr);
+	    varPtr->hPtr = hPtr;
+	    varPtr->nsPtr = arrayPtr->nsPtr;
 	    TclSetVarArrayElement(varPtr);
 	}
     } else {
-	varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr);
-	if (varPtr == NULL) {
+	hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, elName);
+	if (hPtr == NULL) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
-		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
-			noSuchElement, index);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
-			TclGetString(elNamePtr), NULL);
+		VarErrMsg(interp, arrayName, elName, msg, noSuchElement);
 	    }
+	    return NULL;
 	}
     }
-    return varPtr;
+    return (Var *) Tcl_GetHashValue(hPtr);
 }
 
 /*
@@ -1187,9 +993,9 @@ TclLookupArrayElement(
  *
  * 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.
@@ -1200,26 +1006,16 @@ TclLookupArrayElement(
  *----------------------------------------------------------------------
  */
 
-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,
+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,
 				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
 				 * bits. */
 {
-    Tcl_Obj *varNamePtr, *resultPtr;
-
-    varNamePtr = Tcl_NewStringObj(varName, -1);
-    Tcl_IncrRefCount(varNamePtr);
-    resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags);
-    TclDecrRefCount(varNamePtr);
-
-    if (resultPtr == NULL) {
-	return NULL;
-    }
-    return TclGetString(resultPtr);
+    return Tcl_GetVar2(interp, varName, (char *) NULL, flags);
 }
 
 /*
@@ -1227,17 +1023,17 @@ Tcl_GetVar(
  *
  * 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.
@@ -1245,39 +1041,25 @@ Tcl_GetVar(
  *----------------------------------------------------------------------
  */
 
-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
+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
 				 * 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 *resultPtr, *part1Ptr, *part2Ptr;
-
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
-    if (part2) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
-    }
-
-    resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+    Tcl_Obj *objPtr;
 
-    Tcl_DecrRefCount(part1Ptr);
-    if (part2Ptr) {
-	Tcl_DecrRefCount(part2Ptr);
-    }
-    if (resultPtr == NULL) {
+    objPtr = Tcl_GetVar2Ex(interp, part1, part2, flags);
+    if (objPtr == NULL) {
 	return NULL;
     }
-    return TclGetString(resultPtr);
+    return TclGetString(objPtr);
 }
 
 /*
@@ -1285,8 +1067,8 @@ Tcl_GetVar2(
  *
  * 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
@@ -1296,43 +1078,35 @@ Tcl_GetVar2(
  *	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(
-    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(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
 				 * 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. */
 {
-    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
-
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
-    if (part2) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
-    }
-
-    resPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);
+    Var *varPtr, *arrayPtr;
 
-    Tcl_DecrRefCount(part1Ptr);
-    if (part2Ptr) {
-	Tcl_DecrRefCount(part2Ptr);
+    /* 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;
     }
 
-    return resPtr;
+    return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
 }
 
 /*
@@ -1340,8 +1114,8 @@ Tcl_GetVar2Ex(
  *
  * 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
@@ -1351,41 +1125,41 @@ Tcl_GetVar2Ex(
  *	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_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
+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
 				 * 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;
 
-    /*
-     * Filter to pass through only the flags this interface supports.
-     */
-
+    part1 = Tcl_GetString(part1Ptr);
+    part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));
+    
+    /* Filter to pass through only the flags this interface supports. */
     flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
-    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
-	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
+    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
+            /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
 	return NULL;
     }
 
-    return TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-	    flags, -1);
+    return TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags);
 }
 
 /*
@@ -1393,53 +1167,50 @@ Tcl_ObjGetVar2(
  *
  * 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(
-    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
+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
 				 * in the array part1. */
-    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. */
+    CONST int flags;		/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * and TCL_LEAVE_ERR_MSG bits. */
 {
     Interp *iPtr = (Interp *) interp;
-    const char *msg;
+    CONST char *msg;
 
     /*
-     * Invoke any read traces that have been set for the variable.
+     * Invoke any traces that have been set for the variable.
      */
 
-    if ((varPtr->flags & VAR_TRACED_READ)
-	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
-	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
-		part1Ptr, part2Ptr,
+    if ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2,
 		(flags & (TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY))
-		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
+		| TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) {
 	    goto errorReturn;
 	}
     }
@@ -1447,32 +1218,31 @@ TclPtrGetVar(
     /*
      * 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
-		&& !TclIsVarUndefined(arrayPtr)) {
+	if (TclIsVarUndefined(varPtr) && (arrayPtr != NULL)
+	        && !TclIsVarUndefined(arrayPtr)) {
 	    msg = noSuchElement;
 	} else if (TclIsVarArray(varPtr)) {
 	    msg = isArray;
 	} else {
 	    msg = noSuchVar;
 	}
-	TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
+	VarErrMsg(interp, part1, part2, "read", msg);
     }
 
     /*
-     * 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:
-    Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", NULL);
+    errorReturn:
     if (TclIsVarUndefined(varPtr)) {
-	TclCleanupVar(varPtr, arrayPtr);
+	CleanupVar(varPtr, arrayPtr);
     }
     return NULL;
 }
@@ -1482,8 +1252,8 @@ TclPtrGetVar(
  *
  * Tcl_SetObjCmd --
  *
- *	This function is invoked to process the "set" Tcl command. See the
- *	user documentation for details on what it does.
+ *	This procedure is invoked to process the "set" Tcl command.
+ *	See the user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result value.
@@ -1496,22 +1266,23 @@ TclPtrGetVar(
 
 	/* ARGSUSED */
 int
-Tcl_SetObjCmd(
-    ClientData dummy,		/* Not used. */
-    register Tcl_Interp *interp,/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_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) {
@@ -1534,47 +1305,33 @@ Tcl_SetObjCmd(
  *
  * 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(
-    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(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. */
 {
-    Tcl_Obj *valuePtr, *varNamePtr, *varValuePtr;
-
-    varNamePtr = Tcl_NewStringObj(varName, -1);
-    Tcl_IncrRefCount(varNamePtr);
-    valuePtr = Tcl_NewStringObj(newValue, -1);
-    Tcl_IncrRefCount(valuePtr);
-
-    varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, valuePtr, flags);
-
-    Tcl_DecrRefCount(varNamePtr);
-    Tcl_DecrRefCount(valuePtr);
-    if (varValuePtr == NULL) {
-	return NULL;
-    }
-    return TclGetString(varValuePtr);
+    return Tcl_SetVar2(interp, varName, (char *) NULL, newValue, flags);
 }
 
 /*
@@ -1582,63 +1339,57 @@ Tcl_SetVar(
  *
  * 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(
-    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(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
 				 * 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 */
 {
-    Tcl_Obj *valuePtr, *part1Ptr, *part2Ptr;
+    register Tcl_Obj *valuePtr;
     Tcl_Obj *varValuePtr;
 
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
-    if (part2 != NULL) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
-    }
+    /*
+     * Create an object holding the variable's new value and use
+     * Tcl_SetVar2Ex to actually set the variable.
+     */
+
     valuePtr = Tcl_NewStringObj(newValue, -1);
     Tcl_IncrRefCount(valuePtr);
 
-    varValuePtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, valuePtr, flags);
-
-    Tcl_DecrRefCount(part1Ptr);
-    if (part2Ptr != NULL) {
-	Tcl_DecrRefCount(part2Ptr);
-    }
-    Tcl_DecrRefCount(valuePtr);
+    varValuePtr = Tcl_SetVar2Ex(interp, part1, part2, valuePtr, flags);
+    Tcl_DecrRefCount(valuePtr); /* done with the object */
+    
     if (varValuePtr == NULL) {
 	return NULL;
     }
@@ -1658,10 +1409,10 @@ Tcl_SetVar2(
  * 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:
@@ -1670,52 +1421,46 @@ Tcl_SetVar2(
  *
  *	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(
-    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(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
 				 * 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. */
 {
-    Tcl_Obj *part1Ptr, *part2Ptr, *resPtr;
-
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
-    if (part2) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2Ptr = NULL;
-    }
-
-    resPtr = Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags);
+    Var *varPtr, *arrayPtr;
 
-    Tcl_DecrRefCount(part1Ptr);
-    if (part2Ptr) {
-	Tcl_DecrRefCount(part2Ptr);
+    /* 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;
     }
 
-    return resPtr;
+    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 
+            newValuePtr, flags);
 }
 
 /*
@@ -1723,16 +1468,16 @@ Tcl_SetVar2Ex(
  *
  * 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:
@@ -1743,184 +1488,167 @@ Tcl_SetVar2Ex(
  */
 
 Tcl_Obj *
-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
+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
 				 * 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;
 
-    /*
-     * Filter to pass through only the flags this interface supports.
-     */
+    part1 = TclGetString(part1Ptr);
+    part2 = ((part2Ptr == NULL) ? NULL : Tcl_GetString(part2Ptr));    
 
+    /* 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 = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "set",
+    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "set",
 	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
     if (varPtr == NULL) {
-	if (newValuePtr->refCount == 0) {
-	    Tcl_DecrRefCount(newValuePtr);
-	}
 	return NULL;
     }
 
-    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-	    newValuePtr, flags, -1);
+    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, 
+            newValuePtr, flags);
 }
 
+
 /*
  *----------------------------------------------------------------------
  *
  * 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(
-    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
+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
 				 * 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. */
-    int index)			/* Index of local var where part1 is to be
-				 * found. */
+    Tcl_Obj *newValuePtr;	/* New value for variable. */
+    CONST int flags;		/* OR-ed combination of TCL_GLOBAL_ONLY,
+				 * and TCL_LEAVE_ERR_MSG bits. */
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_Obj *oldValuePtr;
     Tcl_Obj *resultPtr = NULL;
     int result;
-    int cleanupOnEarlyError = (newValuePtr->refCount == 0);
 
     /*
      * 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 (TclIsVarDeadHash(varPtr)) {
+    if ((varPtr->flags & VAR_IN_HASHTABLE) && (varPtr->hPtr == NULL)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    if (TclIsVarArrayElement(varPtr)) {
-		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
-			danglingElement, index);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
+		VarErrMsg(interp, part1, part2, "set", danglingElement);
 	    } else {
-		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
-			danglingVar, index);
-		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
+		VarErrMsg(interp, part1, part2, "set", danglingVar);
 	    }
 	}
-	goto earlyError;
+	return NULL;
     }
 
     /*
      * It's an error to try to set an array variable itself.
      */
 
-    if (TclIsVarArray(varPtr)) {
+    if (TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index);
-	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+	    VarErrMsg(interp, part1, part2, "set", isArray);
 	}
-	goto earlyError;
+	return NULL;
     }
 
     /*
-     * Invoke any read traces that have been set for the variable if it is
+     * Invoke any read traces that have been set for the variable if it
      * 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].
      */
 
-    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;
+    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;
 	}
     }
 
     /*
-     * 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)) {
-	varPtr->value.objPtr = NULL;
+	TclSetVarUndefined(varPtr);
     }
+    oldValuePtr = varPtr->value.objPtr;
     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
-#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
-	/*
-	 * Can't happen now!
-	 */
-
 	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
-	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
+	    Tcl_DecrRefCount(oldValuePtr);     /* discard old value */
 	    varPtr->value.objPtr = NULL;
 	    oldValuePtr = NULL;
 	}
-#endif
-	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
+	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);
-		TclDecrRefCount(oldValuePtr);
+		Tcl_DecrRefCount(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) {
-		goto earlyError;
+		return NULL;
 	    }
-	} else {				/* Append string. */
+	} else {		               /* append string */
 	    /*
 	     * We append newValuePtr's bytes but don't change its ref count.
 	     */
@@ -1929,40 +1657,51 @@ TclPtrSetVar(
 		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);
-
-		    TclContinuationsCopy(varPtr->value.objPtr, 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.
+		     */
+		    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->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)) {
+    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))) {
 	    goto cleanup;
 	}
     }
@@ -1970,7 +1709,7 @@ TclPtrSetVar(
     /*
      * 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)) {
@@ -1981,45 +1720,36 @@ TclPtrSetVar(
      * 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:
-    if (resultPtr == NULL) {
-	Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", NULL);
-    }
+    cleanup:
     if (TclIsVarUndefined(varPtr)) {
-	TclCleanupVar(varPtr, arrayPtr);
+	CleanupVar(varPtr, arrayPtr);
     }
     return resultPtr;
-
-  earlyError:
-    if (cleanupOnEarlyError) {
-	Tcl_DecrRefCount(newValuePtr);
-    }
-    goto cleanup;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclIncrObjVar2 --
+ * TclIncrVar2 --
  *
  *	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 Tcl_Obj increment value.
+ *	variable or an element of an array, increment the Tcl object value
+ *	of the variable by a specified amount.
  *
  * 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
@@ -2032,48 +1762,53 @@ TclPtrSetVar(
  */
 
 Tcl_Obj *
-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
+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
 				 * the name of an element in the array
 				 * part1Ptr. */
-    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. */
+    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. */
 {
     Var *varPtr, *arrayPtr;
+    char *part1, *part2;
 
-    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
-	    1, 1, &arrayPtr);
+    part1 = TclGetString(part1Ptr);
+    part2 = ((part2Ptr == NULL)? NULL : TclGetString(part2Ptr));
+
+    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "read",
+	    0, 1, &arrayPtr);
     if (varPtr == NULL) {
 	Tcl_AddObjErrorInfo(interp,
 		"\n    (reading value of variable to increment)", -1);
 	return NULL;
     }
-    return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
-	    incrPtr, flags, -1);
+    return TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2,
+	    incrAmount, flags);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclPtrIncrObjVar --
+ * TclPtrIncrVar --
  *
- *	Given the pointers to a variable and possible containing array,
- *	increment the Tcl object value of the variable by a Tcl_Obj increment.
+ *	Given the pointers to a variable and possible containing array, 
+ *      increment the Tcl object value of the variable by a specified 
+ *      amount.
  *
  * 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
@@ -2086,57 +1821,81 @@ TclIncrObjVar2(
  */
 
 Tcl_Obj *
-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
+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
 				 * the name of an element in the array
 				 * part1Ptr. */
-    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. */
+    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. */
 {
-    register Tcl_Obj *varValuePtr, *newValuePtr = NULL;
-    int duplicated, code;
+    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) {
-	varValuePtr = Tcl_NewIntObj(0);
+	Tcl_AddObjErrorInfo(interp,
+		"\n    (reading value of variable to increment)", -1);
+	return NULL;
     }
+
+    /*
+     * 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)) {
-	duplicated = 1;
 	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 {
-	duplicated = 0;
-    }
-    code = TclIncrObj(interp, varValuePtr, incrPtr);
-    if (code == TCL_OK) {
-	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr,
-		part2Ptr, varValuePtr, flags, index);
-    } else if (duplicated) {
-	Tcl_DecrRefCount(varValuePtr);
+	/*
+	 * 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 */
+	    }
+	    return NULL;
+	}
+	if (wide <= Tcl_LongAsWide(LONG_MAX)
+		&& wide >= Tcl_LongAsWide(LONG_MIN)) {
+	    Tcl_SetLongObj(varValuePtr, Tcl_WideAsLong(wide) + incrAmount);
+	} else {
+	    Tcl_SetWideIntObj(varValuePtr, wide + Tcl_LongAsWide(incrAmount));
+	}
     }
-    return newValuePtr;
+
+    /*
+     * Store the variable's new value and run any write traces.
+     */
+    
+    return TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2,
+	    varValuePtr, flags);
 }
 
 /*
@@ -2147,44 +1906,30 @@ TclPtrIncrObjVar(
  *	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(
-    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(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_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    int result;
-    Tcl_Obj *varNamePtr;
-
-    varNamePtr = Tcl_NewStringObj(varName, -1);
-    Tcl_IncrRefCount(varNamePtr);
-
-    /*
-     * Filter to pass through only the flags this interface supports.
-     */
-
-    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
-    result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags);
-
-    Tcl_DecrRefCount(varNamePtr);
-    return result;
+    return Tcl_UnsetVar2(interp, varName, (char *) NULL, flags);
 }
 
 /*
@@ -2195,52 +1940,42 @@ Tcl_UnsetVar(
  *	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(
-    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(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_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * TCL_LEAVE_ERR_MSG. */
 {
     int result;
-    Tcl_Obj *part1Ptr, *part2Ptr = NULL;
+    Tcl_Obj *part1Ptr;
 
     part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
-    if (part2) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(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);
-    result = TclObjUnsetVar2(interp, part1Ptr, part2Ptr, flags);
+    result = TclObjUnsetVar2(interp, part1Ptr, part2, flags);
+    TclDecrRefCount(part1Ptr);
 
-    Tcl_DecrRefCount(part1Ptr);
-    if (part2Ptr) {
-	Tcl_DecrRefCount(part2Ptr);
-    }
     return result;
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -2250,120 +1985,76 @@ Tcl_UnsetVar2(
  *	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(
-    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
+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
 				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
 				 * TCL_LEAVE_ERR_MSG. */
 {
-    Var *varPtr, *arrayPtr;
+    Var *varPtr;
+    Interp *iPtr = (Interp *) interp;
+    Var *arrayPtr;
+    int result;
+    char *part1;
 
-    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
+    part1 = TclGetString(part1Ptr);
+    varPtr = TclObjLookupVar(interp, part1Ptr, part2, flags, "unset",
 	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
     if (varPtr == NULL) {
 	return TCL_ERROR;
     }
-
-    return TclPtrUnsetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, flags,
-	    -1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclPtrUnsetVar --
- *
- *	Delete a variable, given the pointers to the variable's (and possibly
- *	containing array's) VAR structure.
- *
- * 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.
- *
- * Side effects:
- *	If varPtr and arrayPtr indicate a local or global variable in interp,
- *	it is deleted. If varPtr is an array reference and part2Ptr is NULL,
- *	then the whole array is deleted.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclPtrUnsetVar(
-    Tcl_Interp *interp,		/* Command interpreter in which varName is to
-				 * be looked up. */
-    register Var *varPtr,	/* The variable to be unset. */
-    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 any of
-				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
-				 * TCL_LEAVE_ERR_MSG. */
-    int index)			/* Index into the local variable table of the
-				 * variable, or -1. Only used when part1Ptr is
-				 * NULL. */
-{
-    Interp *iPtr = (Interp *) interp;
-    int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
+ 
+    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++;
 
-    if (TclIsVarInHash(varPtr)) {
-	VarHashRefCount(varPtr)++;
-    }
-
-    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);
+    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags);
 
     /*
      * It's an error to unset an undefined variable.
      */
-
+	
     if (result != TCL_OK) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
-	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
-		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), index);
-	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
+	    VarErrMsg(interp, part1, part2, "unset", 
+		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement));
 	}
     }
 
-#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) {
-	TclFreeIntRep(part1Ptr);
+	part1Ptr->typePtr->freeIntRepProc(part1Ptr);
+	part1Ptr->typePtr = NULL;
     }
-#endif
 
     /*
      * Finally, if the variable is truly not in use then free up its Var
@@ -2371,10 +2062,8 @@ TclPtrUnsetVar(
      * its value object, if any, was decremented above.
      */
 
-    if (TclIsVarInHash(varPtr)) {
-	VarHashRefCount(varPtr)--;
-	CleanupVar(varPtr, arrayPtr);
-    }
+    varPtr->refCount--;
+    CleanupVar(varPtr, arrayPtr);
     return result;
 }
 
@@ -2392,824 +2081,504 @@ TclPtrUnsetVar(
  *
  * Side effects:
  *	If the arguments indicate a local or global variable in iPtr, it is
- *	unset and deleted.
+ *      unset and deleted.   
  *
  *----------------------------------------------------------------------
  */
 
 static void
-UnsetVarStruct(
-    Var *varPtr,
-    Var *arrayPtr,
-    Interp *iPtr,
-    Tcl_Obj *part1Ptr,
-    Tcl_Obj *part2Ptr,
-    int flags,
-    int index)
+UnsetVarStruct(varPtr, arrayPtr, iPtr, part1, part2, flags)
+    Var *varPtr;
+    Var *arrayPtr;
+    Interp *iPtr;
+    CONST char *part1;
+    CONST char *part2;
+    int flags;
 {
     Var dummyVar;
-    int traced = TclIsVarTraced(varPtr)
-	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET));
+    Var *dummyVarPtr;
+    ActiveVarTrace *activePtr;
 
-    if (arrayPtr && (arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
-	DeleteSearches(iPtr, arrayPtr);
-    } else if (varPtr->flags & VAR_SEARCH_ACTIVE) {
-	DeleteSearches(iPtr, varPtr);
+    if ((arrayPtr != NULL) && (arrayPtr->searchPtr != NULL)) {
+	DeleteSearches(arrayPtr);
     }
 
     /*
-     * 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.
+     * 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.
      * 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 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
+     * 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
      *    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 (traced) {
-	VarTrace *tracePtr = NULL;
-	Tcl_HashEntry *tPtr;
-
-	if (TclIsVarTraced(&dummyVar)) {
-	    /*
-	     * Transfer any existing traces on var, IF there are unset traces.
-	     * Otherwise just delete them.
-	     */
-
-	    int isNew;
-
-	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
-	    tracePtr = Tcl_GetHashValue(tPtr);
-	    varPtr->flags &= ~VAR_ALL_TRACES;
-	    Tcl_DeleteHashEntry(tPtr);
-	    if (dummyVar.flags & VAR_TRACED_UNSET) {
-		tPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
-			&dummyVar, &isNew);
-		Tcl_SetHashValue(tPtr, tracePtr);
-	    }
-	}
-
-	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, index);
-
-	    /*
-	     * The traces that we just called may have triggered a change in
-	     * the set of traces. If so, reload the traces to manipulate.
-	     */
-
-	    tracePtr = NULL;
-	    if (TclIsVarTraced(&dummyVar)) {
-		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
-		tracePtr = Tcl_GetHashValue(tPtr);
-		if (tPtr) {
-		    Tcl_DeleteHashEntry(tPtr);
-		}
-	    }
-	}
-
-	if (tracePtr) {
-	    ActiveVarTrace *activePtr;
-
-	    while (tracePtr) {
-		VarTrace *prevPtr = tracePtr;
-
-		tracePtr = tracePtr->nextPtr;
-		prevPtr->nextPtr = NULL;
-		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
-	    }
-	    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
-		    activePtr = activePtr->nextPtr) {
-		if (activePtr->varPtr == varPtr) {
-		    activePtr->nextTracePtr = NULL;
-		}
+    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;
 	    }
-	    dummyVar.flags &= ~VAR_ALL_TRACES;
 	}
     }
 
-    if (TclIsVarScalar(&dummyVar) && (dummyVar.value.objPtr != NULL)) {
-	/*
-	 * Decrement the ref count of the var's value.
-	 */
-
-	Tcl_Obj *objPtr = dummyVar.value.objPtr;
+    /*
+     * 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).
+     */
 
+    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);
-    } 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.
-	 */
-
-	DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags
-		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS,
-		index);
-    } 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.
-	 */
-
-	Var *linkPtr = dummyVar.value.linkPtr;
-
-	if (TclIsVarInHash(linkPtr)) {
-	    VarHashRefCount(linkPtr)--;
-	    CleanupVar(linkPtr, NULL);
-	}
+	dummyVarPtr->value.objPtr = NULL;
     }
 
     /*
-     * If the variable was a namespace variable, decrement its reference
-     * count.
+     * If the variable was a namespace variable, decrement its reference count.
      */
+    
+    if (varPtr->flags & VAR_NAMESPACE_VAR) {
+	varPtr->flags &= ~VAR_NAMESPACE_VAR;
+	varPtr->refCount--;
+    }
 
-    TclClearVarNamespaceVar(varPtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_UnsetObjCmd --
+ * Tcl_TraceVar --
  *
- *	This object-based function is invoked to process the "unset" Tcl
- *	command. See the user documentation for details on what it does.
+ *	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 object result value.
+ *	A standard Tcl return value.
  *
  * Side effects:
- *	See the user documentation.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_UnsetObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
-    register int i, flags = TCL_LEAVE_ERR_MSG;
-    register const char *name;
-
-    if (objc == 1) {
-	/*
-	 * 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).
-     */
-
-    i = 1;
-    name = TclGetString(objv[i]);
-    if (name[0] == '-') {
-	if (strcmp("-nocomplain", name) == 0) {
-	    i++;
-	    if (i == objc) {
-		return TCL_OK;
-	    }
-	    flags = 0;
-	    name = TclGetString(objv[i]);
-	}
-	if (strcmp("--", name) == 0) {
-	    i++;
-	}
-    }
-
-    for (; i < objc; i++) {
-	if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)
-		&& (flags == TCL_LEAVE_ERR_MSG)) {
-	    return TCL_ERROR;
-	}
-    }
-    return TCL_OK;
+    return Tcl_TraceVar2(interp, varName, (char *) NULL, 
+	    flags, proc, clientData);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_AppendObjCmd --
+ * Tcl_TraceVar2 --
  *
- *	This object-based function is invoked to process the "append" Tcl
- *	command. See the user documentation for details on what it does.
+ *	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 object result value.
+ *	A standard Tcl return value.
  *
  * Side effects:
- *	A variable's value may be changed.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
 int
-Tcl_AppendObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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 Tcl_Obj *varValuePtr = NULL;
-				/* Initialized to avoid compiler warning. */
-    int i;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
+    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;
     }
 
-    if (objc == 2) {
-	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
-	if (varValuePtr == NULL) {
-	    return TCL_ERROR;
-	}
-    } else {
-	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
-		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-	if (varPtr == NULL) {
-	    return TCL_ERROR;
-	}
-	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 or emptyObjPtr, and we will not
-	     * access the variable again.
-	     */
-
-	    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;
-	    }
-	}
+    /*
+     * 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");
     }
-    Tcl_SetObjResult(interp, varValuePtr);
+
+    /*
+     * 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 = (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_LappendObjCmd --
+ * Tcl_UntraceVar --
  *
- *	This object-based function is invoked to process the "lappend" Tcl
- *	command. See the user documentation for details on what it does.
+ *	Remove a previously-created trace for a variable.
  *
  * Results:
- *	A standard Tcl object result value.
+ *	None.
  *
  * Side effects:
- *	A variable's value may be changed.
+ *	If there exists a trace for the variable given by varName
+ *	with the given flags, proc, and clientData, then that trace
+ *	is removed.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-int
-Tcl_LappendObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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_Obj *varValuePtr, *newValuePtr;
-    int numElems, createdNewObj;
-    Var *varPtr, *arrayPtr;
-    int result;
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
-	return TCL_ERROR;
-    }
-    if (objc == 2) {
-	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.
-	     */
-
-	    TclNewObj(varValuePtr);
-	    newValuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL, varValuePtr,
-		    TCL_LEAVE_ERR_MSG);
-	    if (newValuePtr == NULL) {
-		return TCL_ERROR;
-	    }
-	} else {
-	    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".
-	 */
-
-	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 = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
-		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
-	if (varPtr == NULL) {
-	    return TCL_ERROR;
-	}
-	if (TclIsVarInHash(varPtr)) {
-	    VarHashRefCount(varPtr)++;
-	}
-	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)--;
-	}
-
-	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
-	     * create it with Tcl_ObjSetVar2 below.
-	     */
-
-	    TclNewObj(varValuePtr);
-	    createdNewObj = 1;
-	} else if (Tcl_IsShared(varValuePtr)) {
-	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
-	    createdNewObj = 1;
-	}
-
-	result = TclListObjLength(interp, varValuePtr, &numElems);
-	if (result == TCL_OK) {
-	    result = Tcl_ListObjReplace(interp, varValuePtr, numElems, 0,
-		    (objc-2), (objv+2));
-	}
-	if (result != TCL_OK) {
-	    if (createdNewObj) {
-		TclDecrRefCount(varValuePtr); /* Free unneeded obj. */
-	    }
-	    return result;
-	}
-
-	/*
-	 * 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.
-	 */
-
-	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL,
-		varValuePtr, TCL_LEAVE_ERR_MSG, -1);
-	if (newValuePtr == NULL) {
-	    return TCL_ERROR;
-	}
-    }
-
-    /*
-     * Set the interpreter's object result to refer to the variable's value
-     * object.
-     */
-
-    Tcl_SetObjResult(interp, newValuePtr);
-    return TCL_OK;
+    Tcl_UntraceVar2(interp, varName, (char *) NULL, flags, proc, clientData);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclArraySet --
+ * Tcl_UntraceVar2 --
  *
- *	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.
+ *	Remove a previously-created trace for a variable.
  *
  * Results:
- *	A standard Tcl result object.
+ *	None.
  *
  * Side effects:
- *	A variable will be created if one does not already exist.
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-int
-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. */
+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;
-    int result, i;
-
-    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
-	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
-	    /*createPart2*/ 1, &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 TCL_ERROR;
-    }
-    if (arrayPtr) {
-	CleanupVar(varPtr, arrayPtr);
-	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-		TclGetString(arrayNameObj), NULL);
-	return TCL_ERROR;
+	return;
     }
 
-    if (arrayElemObj == NULL) {
-	goto ensureArray;
-    }
 
     /*
-     * Install the contents of the dictionary or list into the array.
+     * Set up a mask to mask out the parts of the flags that we are not
+     * interested in now.
      */
-
-    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;
+    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;
 	}
+    }
 
-	/*
-	 * Don't need to look at result of Tcl_DictObjFirst as we've just
-	 * successfully used a dictionary operation on the same object.
-	 */
-
-	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);
+    /*
+     * 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.
+     */
 
-	    if ((elemVarPtr == NULL) ||
-		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
-		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
-		Tcl_DictObjDone(&search);
-		return TCL_ERROR;
-	    }
+    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
+	 activePtr = activePtr->nextPtr) {
+	if (activePtr->nextTracePtr == tracePtr) {
+	    activePtr->nextTracePtr = tracePtr->nextPtr;
 	}
-	return TCL_OK;
+    }
+    if (prevPtr == NULL) {
+	varPtr->tracePtr = tracePtr->nextPtr;
     } 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_SetObjResult(interp, Tcl_NewStringObj(
-		    "list must have an even number of elements", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
-	    return TCL_ERROR;
-	}
-	if (elemLen == 0) {
-	    goto ensureArray;
-	}
-
-	/*
-	 * 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.
-	 */
-
-	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;
-	    }
-	}
-	Tcl_DecrRefCount(copyListObj);
-	return result;
+	prevPtr->nextPtr = tracePtr->nextPtr;
     }
+    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);
 
     /*
-     * The list is empty make sure we have an array, or create one if
-     * necessary.
+     * If this is the last trace on the variable, and the variable is
+     * unset and unused, then free up the variable.
      */
 
-  ensureArray:
-    if (varPtr != NULL) {
-	if (TclIsVarArray(varPtr)) {
-	    /*
-	     * Already an array, done.
-	     */
-
-	    return TCL_OK;
-	}
-	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
-	    /*
-	     * Either an array element, or a scalar: lose!
-	     */
-
-	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
-		    needArray, -1);
-	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
-	    return TCL_ERROR;
-	}
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, (Var *) NULL);
     }
-    TclSetVarArray(varPtr);
-    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
-    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
-    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ArrayStartSearchCmd --
+ * Tcl_VarTraceInfo --
  *
- *	This object-based function is invoked to process the "array
- *	startsearch" Tcl command. See the user documentation for details on
- *	what it does.
+ *	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:
- *	A standard Tcl result object.
+ *	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:
- *	See the user documentation.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static int
-ArrayStartSearchCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *arrayPtr;
-    Tcl_HashEntry *hPtr;
-    Tcl_Obj *varNameObj;
-    int isNew;
-    ArraySearch *searchPtr;
-    const char *varName;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
-	return TCL_ERROR;
-    }
-    varNameObj = objv[1];
-
-    /*
-     * Locate the array variable.
-     */
-
-    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
-	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
-    varName = TclGetString(varNameObj);
-
-    /*
-     * Special array trace used to keep the env array in sync for array names,
-     * array get, etc.
-     */
-
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		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.
-     */
-
-    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr)) {
-	Tcl_AppendResult(interp, "\"", varName, "\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", varName, NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Make a new array search with a free name.
-     */
-
-    searchPtr = ckalloc(sizeof(ArraySearch));
-    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
-    if (isNew) {
-	searchPtr->id = 1;
-	varPtr->flags |= VAR_SEARCH_ACTIVE;
-	searchPtr->nextPtr = NULL;
-    } else {
-	searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
-	searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
-    }
-    searchPtr->varPtr = varPtr;
-    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
-	    &searchPtr->search);
-    Tcl_SetHashValue(hPtr, searchPtr);
-    Tcl_SetObjResult(interp,
-	    Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName));
-    return TCL_OK;
+    return Tcl_VarTraceInfo2(interp, varName, (char *) NULL,
+	    flags, proc, prevClientData);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ArrayAnyMoreCmd --
+ * Tcl_VarTraceInfo2 --
  *
- *	This object-based function is invoked to process the "array anymore"
- *	Tcl command. See the user documentation for details on what it does.
+ *	Same as Tcl_VarTraceInfo, except takes name in two pieces
+ *	instead of one.
  *
  * Results:
- *	A standard Tcl result object.
+ *	Same as Tcl_VarTraceInfo.
  *
  * Side effects:
- *	See the user documentation.
+ *	None.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static int
-ArrayAnyMoreCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
+    register VarTrace *tracePtr;
     Var *varPtr, *arrayPtr;
-    Tcl_Obj *varNameObj, *searchObj;
-    int gotValue;
-    ArraySearch *searchPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
-	return TCL_ERROR;
-    }
-    varNameObj = objv[1];
-    searchObj = objv[2];
-
-    /*
-     * Locate the array variable.
-     */
-
-    varPtr = TclObjLookupVarEx(interp, varNameObj, 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.
-     */
-
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		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.
-     */
 
-    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr)) {
-	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
-		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
-		TclGetString(varNameObj), NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get the search.
-     */
-
-    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
-    if (searchPtr == NULL) {
-	return TCL_ERROR;
+    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;
     }
 
     /*
-     * Scan forward to find if there are any further elements in the array
-     * that are defined.
+     * Find the relevant trace, if any, and return its clientData.
      */
 
-    while (1) {
-	if (searchPtr->nextEntry != NULL) {
-	    varPtr = VarHashGetValue(searchPtr->nextEntry);
-	    if (!TclIsVarUndefined(varPtr)) {
-		gotValue = 1;
+    tracePtr = varPtr->tracePtr;
+    if (prevClientData != NULL) {
+	for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	    if ((tracePtr->clientData == prevClientData)
+		    && (tracePtr->traceProc == proc)) {
+		tracePtr = tracePtr->nextPtr;
 		break;
 	    }
 	}
-	searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
-	if (searchPtr->nextEntry == NULL) {
-	    gotValue = 0;
-	    break;
+    }
+    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
+	if (tracePtr->traceProc == proc) {
+	    return tracePtr->clientData;
 	}
     }
-    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[gotValue]);
-    return TCL_OK;
+    return NULL;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ArrayNextElementCmd --
+ * Tcl_UnsetObjCmd --
  *
- *	This object-based function is invoked to process the "array
- *	nextelement" Tcl command. See the user documentation for details on
- *	what it does.
+ *	This object-based procedure is invoked to process the "unset" Tcl
+ *	command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result object.
+ *	A standard Tcl object result value.
  *
  * Side effects:
  *	See the user documentation.
@@ -3218,462 +2587,318 @@ ArrayAnyMoreCmd(
  */
 
 	/* ARGSUSED */
-static int
-ArrayNextElementCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *arrayPtr;
-    Tcl_Obj *varNameObj, *searchObj;
-    ArraySearch *searchPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
-	return TCL_ERROR;
-    }
-    varNameObj = objv[1];
-    searchObj = objv[2];
-
-    /*
-     * Locate the array variable.
-     */
-
-    varPtr = TclObjLookupVarEx(interp, varNameObj, 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.
-     */
-
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		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.
-     */
-
-    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr)) {
-	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
-		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
-		TclGetString(varNameObj), NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get the search.
-     */
+    register int i, flags = TCL_LEAVE_ERR_MSG;
+    register char *name;
 
-    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
-    if (searchPtr == NULL) {
+    if (objc < 1) {
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"?-nocomplain? ?--? ?varName varName ...?");
 	return TCL_ERROR;
+    } else if (objc == 1) {
+	/*
+	 * Do nothing if no arguments supplied, so as to match
+	 * command documentation.
+	 */
+	return TCL_OK;
     }
 
     /*
-     * Get the next element from the search, or the empty string on
-     * exhaustion. Note that the [array anymore] command may well have already
-     * pulled a value from the hash enumeration, so we have to check the cache
-     * there first.
+     * Simple, restrictive argument parsing.  The only options are --
+     * and -nocomplain (which must come first and be given exactly to
+     * be an option).
      */
-
-    while (1) {
-	Tcl_HashEntry *hPtr = searchPtr->nextEntry;
-
-	if (hPtr == NULL) {
-	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
-	    if (hPtr == NULL) {
+    i = 1;
+    name = TclGetString(objv[i]);
+    if (name[0] == '-') {
+ 	if (strcmp("-nocomplain", name) == 0) {
+	    i++;
+ 	    if (i == objc) {
 		return TCL_OK;
 	    }
-	} else {
-	    searchPtr->nextEntry = NULL;
-	}
-	varPtr = VarHashGetValue(hPtr);
-	if (!TclIsVarUndefined(varPtr)) {
-	    Tcl_SetObjResult(interp, VarHashGetKey(varPtr));
-	    return TCL_OK;
+ 	    flags = 0;
+ 	    name = TclGetString(objv[i]);
+ 	}
+ 	if (strcmp("--", name) == 0) {
+ 	    i++;
+ 	}
+    }
+
+    for (; i < objc;  i++) {
+	if ((TclObjUnsetVar2(interp, objv[i], NULL, flags) != TCL_OK)
+		&& (flags == TCL_LEAVE_ERR_MSG)) {
+	    return TCL_ERROR;
 	}
     }
+    return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ArrayDoneSearchCmd --
+ * Tcl_AppendObjCmd --
  *
- *	This object-based function is invoked to process the "array
- *	donesearch" Tcl command. See the user documentation for details on
- *	what it does.
+ *	This object-based procedure is invoked to process the "append" 
+ *	Tcl command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result object.
+ *	A standard Tcl object result value.
  *
  * Side effects:
- *	See the user documentation.
+ *	A variable's value may be changed.
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
-static int
-ArrayDoneSearchCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
     Var *varPtr, *arrayPtr;
-    Tcl_HashEntry *hPtr;
-    Tcl_Obj *varNameObj, *searchObj;
-    ArraySearch *searchPtr, *prevPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
-	return TCL_ERROR;
-    }
-    varNameObj = objv[1];
-    searchObj = objv[2];
-
-    /*
-     * Locate the array variable.
-     */
-
-    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
-	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    char *part1;
 
-    /*
-     * Special array trace used to keep the env array in sync for array names,
-     * array get, etc.
-     */
-
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		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.
-     */
-
-    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr)) {
-	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
-		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
-		TclGetString(varNameObj), NULL);
-	return TCL_ERROR;
-    }
-
-    /*
-     * Get the search.
-     */
+    register Tcl_Obj *varValuePtr = NULL;
+    					/* Initialized to avoid compiler
+				         * warning. */
+    int i;
 
-    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
-    if (searchPtr == NULL) {
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
 	return TCL_ERROR;
     }
 
-    /*
-     * Unhook the search from the list of searches associated with the
-     * variable.
-     */
-
-    hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
-    if (searchPtr == Tcl_GetHashValue(hPtr)) {
-	if (searchPtr->nextPtr) {
-	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
-	} else {
-	    varPtr->flags &= ~VAR_SEARCH_ACTIVE;
-	    Tcl_DeleteHashEntry(hPtr);
+    if (objc == 2) {
+	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+	if (varValuePtr == NULL) {
+	    return TCL_ERROR;
 	}
     } else {
-	for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
-	    if (prevPtr->nextPtr == searchPtr) {
-		prevPtr->nextPtr = searchPtr->nextPtr;
-		break;
+	varPtr = TclObjLookupVar(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++) {	  
+	    /*
+	     * 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.
+	     */
+
+	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, 
+	            objv[i], (TCL_APPEND_VALUE | TCL_LEAVE_ERR_MSG));
+	    if ((varValuePtr == NULL) ||
+		    (varValuePtr == ((Interp *) interp)->emptyObjPtr)) {
+		return TCL_ERROR;
 	    }
 	}
     }
-    ckfree(searchPtr);
+    Tcl_SetObjResult(interp, varValuePtr);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ArrayExistsCmd --
+ * Tcl_LappendObjCmd --
  *
- *	This object-based function is invoked to process the "array exists"
+ *	This object-based procedure is invoked to process the "lappend" 
  *	Tcl command. See the user documentation for details on what it does.
  *
  * Results:
- *	A standard Tcl result object.
+ *	A standard Tcl object result value.
  *
  * Side effects:
- *	See the user documentation.
+ *	A variable's value may be changed.
  *
  *----------------------------------------------------------------------
  */
 
 	/* ARGSUSED */
-static int
-ArrayExistsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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. */
 {
-    Interp *iPtr = (Interp *) interp;
+    Tcl_Obj *varValuePtr, *newValuePtr;
+    register List *listRepPtr;
+    register Tcl_Obj **elemPtrs;
+    int numElems, numRequired, createdNewObj, i, j;
     Var *varPtr, *arrayPtr;
-    Tcl_Obj *arrayNameObj;
-    int notArray;
+    char *part1;
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
 	return TCL_ERROR;
     }
-    arrayNameObj = objv[1];
-
-    /*
-     * Locate the array variable.
-     */
-
-    varPtr = TclObjLookupVarEx(interp, arrayNameObj, 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.
-     */
+    if (objc == 2) {
+	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) 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);
+	    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);
+	    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.
+	 */
 
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, arrayNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
+	varPtr = TclObjLookupVar(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
+		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	if (varPtr == NULL) {
 	    return TCL_ERROR;
 	}
-    }
-
-    /*
-     * Check whether we've actually got an array variable.
-     */
-
-    notArray = ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr));
-    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ArrayGetCmd --
- *
- *	This object-based function is invoked to process the "array get" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result object.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static int
-ArrayGetCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *arrayPtr, *varPtr2;
-    Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
-    Tcl_Obj **nameObjPtr, *patternObj;
-    Tcl_HashSearch search;
-    const char *pattern;
-    int i, count, result;
-
-    switch (objc) {
-    case 2:
-	varNameObj = objv[1];
-	patternObj = NULL;
-	break;
-    case 3:
-	varNameObj = objv[1];
-	patternObj = objv[2];
-	break;
-    default:
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
-	return TCL_ERROR;
-    }
-
-    /*
-     * Locate the array variable.
-     */
+	varPtr->refCount++;
+	if (arrayPtr != NULL) {
+	    arrayPtr->refCount++;
+	}
+	part1 = TclGetString(objv[1]);
+	varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1, NULL, 
+	        TCL_LEAVE_ERR_MSG);
+	varPtr->refCount--;
+	if (arrayPtr != NULL) {
+	    arrayPtr->refCount--;
+	}
 
-    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
-	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &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
+	     * create it with Tcl_ObjSetVar2 below.
+	     */
+	    
+	    varValuePtr = Tcl_NewObj();
+	    createdNewObj = 1;
+	} else if (Tcl_IsShared(varValuePtr)) {	
+	    varValuePtr = Tcl_DuplicateObj(varValuePtr);
+	    createdNewObj = 1;
+	}
 
-    /*
-     * Special array trace used to keep the env array in sync for array names,
-     * array get, etc.
-     */
+	/*
+	 * Convert the variable's old value to a list object if necessary.
+	 */
 
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
-	    return TCL_ERROR;
+	if (varValuePtr->typePtr != &tclListType) {
+	    int result = tclListType.setFromAnyProc(interp, varValuePtr);
+	    if (result != TCL_OK) {
+		if (createdNewObj) {
+		    Tcl_DecrRefCount(varValuePtr); /* free unneeded obj. */
+		}
+		return result;
+	    }
 	}
-    }
-
-    /*
-     * 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. If not an array, it's an empty result.
-     */
+	listRepPtr = (List *) varValuePtr->internalRep.twoPtrValue.ptr1;
+	elemPtrs = listRepPtr->elements;
+	numElems = listRepPtr->elemCount;
 
-    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr)) {
-	return TCL_OK;
-    }
+	/*
+	 * 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;
+	}
 
-    pattern = (patternObj ? TclGetString(patternObj) : NULL);
+	/*
+	 * Insert the new elements at the end of the list.
+	 */
 
-    /*
-     * Store the array names in a new object.
-     */
+	for (i = 2, j = numElems;  i < objc;  i++, j++) {
+            elemPtrs[j] = objv[i];
+            Tcl_IncrRefCount(objv[i]);
+        }
+	listRepPtr->elemCount = numRequired;
 
-    TclNewObj(nameLstObj);
-    Tcl_IncrRefCount(nameLstObj);
-    if ((patternObj != NULL) && TclMatchIsTrivial(pattern)) {
-	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
-	if (varPtr2 == NULL) {
-	    goto searchDone;
-	}
-	if (TclIsVarUndefined(varPtr2)) {
-	    goto searchDone;
-	}
-	result = Tcl_ListObjAppendElement(interp, nameLstObj,
-		VarHashGetKey(varPtr2));
-	if (result != TCL_OK) {
-	    TclDecrRefCount(nameLstObj);
-	    return result;
-	}
-	goto searchDone;
-    }
+	/*
+	 * Invalidate and free any old string representation since it no
+	 * longer reflects the list's internal representation.
+	 */
 
-    for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
-	    varPtr2; varPtr2 = VarHashNextVar(&search)) {
-	if (TclIsVarUndefined(varPtr2)) {
-	    continue;
-	}
-	nameObj = VarHashGetKey(varPtr2);
-	if (patternObj && !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
-	    continue;		/* Element name doesn't match pattern. */
-	}
+	Tcl_InvalidateStringRep(varValuePtr);
 
-	result = Tcl_ListObjAppendElement(interp, nameLstObj, nameObj);
-	if (result != TCL_OK) {
-	    TclDecrRefCount(nameLstObj);
-	    return result;
+	/*
+	 * 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.
+	 */
+	
+	Tcl_IncrRefCount(varValuePtr);
+	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, part1, NULL, 
+	            varValuePtr, TCL_LEAVE_ERR_MSG);	
+	Tcl_DecrRefCount(varValuePtr);
+	if (newValuePtr == NULL) {
+	    return TCL_ERROR;
 	}
     }
 
     /*
-     * Make sure the Var structure of the array is not removed by a trace
-     * while we're working.
-     */
-
-  searchDone:
-    if (TclIsVarInHash(varPtr)) {
-	VarHashRefCount(varPtr)++;
-    }
-
-    /*
-     * Get the array values corresponding to each element name.
+     * Set the interpreter's object result to refer to the variable's value
+     * object.
      */
 
-    TclNewObj(tmpResObj);
-    result = Tcl_ListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
-    if (result != TCL_OK) {
-	goto errorInArrayGet;
-    }
-
-    for (i=0 ; i<count ; i++) {
-	nameObj = *nameObjPtr++;
-	valueObj = Tcl_ObjGetVar2(interp, varNameObj, nameObj,
-		TCL_LEAVE_ERR_MSG);
-	if (valueObj == 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?
-	     */
-
-	    if (TclIsVarArray(varPtr)) {
-		/*
-		 * The array itself looks OK, the variable was undefined:
-		 * forget it.
-		 */
-
-		continue;
-	    }
-	    result = TCL_ERROR;
-	    goto errorInArrayGet;
-	}
-	result = Tcl_DictObjPut(interp, tmpResObj, nameObj, valueObj);
-	if (result != TCL_OK) {
-	    goto errorInArrayGet;
-	}
-    }
-    if (TclIsVarInHash(varPtr)) {
-	VarHashRefCount(varPtr)--;
-    }
-    Tcl_SetObjResult(interp, tmpResObj);
-    TclDecrRefCount(nameLstObj);
+    Tcl_SetObjResult(interp, newValuePtr);
     return TCL_OK;
-
-  errorInArrayGet:
-    if (TclIsVarInHash(varPtr)) {
-	VarHashRefCount(varPtr)--;
-    }
-    TclDecrRefCount(nameLstObj);
-    TclDecrRefCount(tmpResObj);	/* Free unneeded temp result. */
-    return result;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ArrayNamesCmd --
+ * Tcl_ArrayObjCmd --
  *
- *	This object-based function is invoked to process the "array names" Tcl
+ *	This object-based procedure is invoked to process the "array" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -3686,568 +2911,632 @@ ArrayGetCmd(
  */
 
 	/* ARGSUSED */
-static int
-ArrayNamesCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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. */
 {
-    static const char *const options[] = {
-	"-exact", "-glob", "-regexp", NULL
+    /*
+     * 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[] = {
+	"anymore", "donesearch", "exists", "get", "names", "nextelement",
+	"set", "size", "startsearch", "statistics", "unset", (char *) NULL
     };
-    enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
+
     Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *arrayPtr, *varPtr2;
-    Tcl_Obj *varNameObj, *nameObj, *resultObj, *patternObj;
-    Tcl_HashSearch search;
-    const char *pattern = NULL;
-    int mode = OPT_GLOB;
+    Var *varPtr, *arrayPtr;
+    Tcl_HashEntry *hPtr;
+    Tcl_Obj *resultPtr, *varNamePtr;
+    int notArray;
+    char *varName;
+    int index, result;
 
-    if ((objc < 2) || (objc > 4)) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
+
+    if (objc < 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
 	return TCL_ERROR;
     }
-    varNameObj = objv[1];
-    patternObj = (objc > 2 ? objv[objc-1] : NULL);
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option",
+	    0, &index) != TCL_OK) {
+    	return TCL_ERROR;
+    }
 
     /*
-     * Locate the array variable.
+     * Locate the array variable
      */
-
-    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
-	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+    
+    varNamePtr = objv[2];
+    varName = TclGetString(varNamePtr);
+    varPtr = TclObjLookupVar(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 && (varPtr->flags & VAR_TRACED_ARRAY)
+    if (varPtr != NULL && varPtr->tracePtr != NULL
 	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
+	if (TCL_ERROR == CallVarTraces(iPtr, arrayPtr, varPtr, varName, NULL,
 		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
+		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1)) {
 	    return TCL_ERROR;
 	}
     }
 
     /*
-     * Finish parsing the arguments.
-     */
-
-    if ((objc == 4) && Tcl_GetIndexFromObj(interp, objv[2], options, "option",
-	    0, &mode) != TCL_OK) {
-	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. If not an array, the result is empty.
+     * 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;
     if ((varPtr == NULL) || !TclIsVarArray(varPtr)
 	    || TclIsVarUndefined(varPtr)) {
-	return TCL_OK;
+	notArray = 1;
     }
 
     /*
-     * Check for the trivial cases where we can use a direct lookup.
+     * We have to wait to get the resultPtr until here because
+     * CallVarTraces can affect the result.
      */
 
-    TclNewObj(resultObj);
-    if (patternObj) {
-	pattern = TclGetString(patternObj);
-    }
-    if ((mode==OPT_GLOB && patternObj && TclMatchIsTrivial(pattern))
-	    || (mode==OPT_EXACT)) {
-	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
-	if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
-	    /*
-	     * This can't fail; lappending to an empty object always works.
-	     */
-
-	    Tcl_ListObjAppendElement(NULL, resultObj, VarHashGetKey(varPtr2));
-	}
-	Tcl_SetObjResult(interp, resultObj);
-	return TCL_OK;
-    }
+    resultPtr = Tcl_GetObjResult(interp);
 
-    /*
-     * Must scan the array to select the elements.
-     */
+    switch (index) {
+        case ARRAY_ANYMORE: {
+	    ArraySearch *searchPtr;
+	    
+	    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;
+	    }
+	    while (1) {
+	        Var *varPtr2;
 
-    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
-	    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
-	if (TclIsVarUndefined(varPtr2)) {
-	    continue;
+		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;
+		}
+	    }
+	    Tcl_SetIntObj(resultPtr, 1);
+	    break;
 	}
-	nameObj = VarHashGetKey(varPtr2);
-	if (patternObj) {
-	    const char *name = TclGetString(nameObj);
-	    int matched = 0;
-
-	    switch ((enum options) mode) {
-	    case OPT_EXACT:
-		Tcl_Panic("exact matching shouldn't get here");
-	    case OPT_GLOB:
-		matched = Tcl_StringMatch(name, pattern);
-		break;
-	    case OPT_REGEXP:
-		matched = Tcl_RegExpMatchObj(interp, nameObj, patternObj);
-		if (matched < 0) {
-		    TclDecrRefCount(resultObj);
-		    return TCL_ERROR;
+        case ARRAY_DONESEARCH: {
+	    ArraySearch *searchPtr, *prevPtr;
+
+	    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;
+	    }
+	    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;
+		    }
 		}
-		break;
 	    }
-	    if (matched == 0) {
-		continue;
+	    ckfree((char *) searchPtr);
+	    break;
+	}
+        case ARRAY_EXISTS: {
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	        return TCL_ERROR;
 	    }
+	    Tcl_SetIntObj(resultPtr, !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]);
+	    }
 
-	Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
-    }
-    Tcl_SetObjResult(interp, resultObj);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ArraySetCmd --
- *
- *	This object-based function is invoked to process the "array set" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result object.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static int
-ArraySetCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *arrayPtr;
-
-    if (objc != 3) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
-	return TCL_ERROR;
-    }
+	    /*
+	     * Store the array names in a new object.
+	     */
 
-    /*
-     * Locate the array variable.
-     */
+	    nameLstPtr = Tcl_NewObj();
+	    Tcl_IncrRefCount(nameLstPtr);
 
-    varPtr = TclObjLookupVarEx(interp, objv[1], NULL, /*flags*/ 0,
-	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+	    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;
+		}
+	    }
 
-    /*
-     * Special array trace used to keep the env array in sync for array names,
-     * array get, etc.
-     */
+	    /*
+	     * Make sure the Var structure of the array is not removed by
+	     * a trace while we're working.
+	     */
 
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, objv[1], NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
-	    return TCL_ERROR;
-	}
-    }
+	    varPtr->refCount++;
 
-    return TclArraySet(interp, objv[1], objv[2]);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ArraySizeCmd --
- *
- *	This object-based function is invoked to process the "array size" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result object.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
+	    /*
+	     * Get the array values corresponding to each element name 
+	     */
 
-	/* ARGSUSED */
-static int
-ArraySizeCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *arrayPtr;
-    Tcl_Obj *varNameObj;
-    Tcl_HashSearch search;
-    Var *varPtr2;
-    int size = 0;
+	    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) {
+		    /*
+		     * 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?
+		     */
 
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
-	return TCL_ERROR;
-    }
-    varNameObj = objv[1];
+		    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) {
+		    goto errorInArrayGet;
+		}
+	    }
+	    varPtr->refCount--;
+	    Tcl_SetObjResult(interp, tmpResPtr);
+	    Tcl_DecrRefCount(nameLstPtr);
+	    break;
 
-    /*
-     * Locate the array variable.
-     */
+	    errorInArrayGet:
+	    varPtr->refCount--;
+	    Tcl_DecrRefCount(nameLstPtr);
+	    Tcl_DecrRefCount(tmpResPtr); /* free unneeded temp result obj */
+	    return result;
+	}
+        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?");
+		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);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(namePtr); /* free unneeded name obj */
+		    return result;
+		}
+	    }
+	    break;
+	}
+        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;
+	    }
+	    while (1) {
+	        Var *varPtr2;
+
+		hPtr = searchPtr->nextEntry;
+		if (hPtr == NULL) {
+		    hPtr = Tcl_NextHashEntry(&searchPtr->search);
+		    if (hPtr == NULL) {
+		        return TCL_OK;
+		    }
+		} else {
+		    searchPtr->nextEntry = NULL;
+		}
+		varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
+		if (!TclIsVarUndefined(varPtr2)) {
+		    break;
+		}
+	    }
+	    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;
+	    }
+	    return(TclArraySet(interp, objv[2], objv[3]));
+	}
+        case ARRAY_SIZE: {
+	    Tcl_HashSearch search;
+	    Var *varPtr2;
+	    int size;
 
-    varPtr = TclObjLookupVarEx(interp, varNameObj, NULL, /*flags*/ 0,
-	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+	    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;
 
-    /*
-     * Special array trace used to keep the env array in sync for array names,
-     * array get, etc.
-     */
+	    if (objc != 3) {
+	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+		return TCL_ERROR;
+	    }
+	    if (notArray) {
+	        goto error;
+	    }
+	    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];
 
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
-	    return TCL_ERROR;
+		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;
 	}
-    }
 
-    /*
-     * 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. We can only iterate over the array if it exists...
-     */
+	case ARRAY_STATISTICS: {
+	    char *stats;
 
-    if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
-	/*
-	 * Must iterate in order to get chance to check for present but
-	 * "undefined" entries.
-	 */
+	    if (notArray) {
+		goto error;
+	    }
 
-	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
-		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
-	    if (!TclIsVarUndefined(varPtr2)) {
-		size++;
+	    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
+		 */
+		if (TclObjUnsetVar2(interp, varNamePtr, NULL, 0)
+			!= TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    } 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)) {
+			return TCL_ERROR;
+		    }
+		}
+	    }
+	    break;
 	}
     }
-
-    Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
     return TCL_OK;
+
+    error:
+    Tcl_AppendStringsToObj(resultPtr, "\"", varName, "\" isn't an array",
+	    (char *) NULL);
+    return TCL_ERROR;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * ArrayStatsCmd --
+ * TclArraySet --
  *
- *	This object-based function is invoked to process the "array
- *	statistics" Tcl command. See the user documentation for details on
- *	what it does.
+ *	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:
- *	See the user documentation.
+ *	A variable will be created if one does not already exist.
  *
  *----------------------------------------------------------------------
  */
 
-	/* ARGSUSED */
-static int
-ArrayStatsCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
+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
+				 * NULL, create an empty array. */
 {
-    Interp *iPtr = (Interp *) interp;
     Var *varPtr, *arrayPtr;
-    Tcl_Obj *varNameObj;
-    char *stats;
-
-    if (objc != 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
-	return TCL_ERROR;
-    }
-    varNameObj = objv[1];
-
-    /*
-     * Locate the array variable.
-     */
-
-    varPtr = TclObjLookupVarEx(interp, varNameObj, 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.
-     */
-
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
-	    return TCL_ERROR;
+    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;
+	    }
 	}
     }
 
-    /*
-     * 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.
-     */
-
-    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr)) {
-	Tcl_AppendResult(interp, "\"", TclGetString(varNameObj),
-		"\" isn't an array", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY",
-		TclGetString(varNameObj), NULL);
-	return TCL_ERROR;
-    }
-
-    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
-    if (stats == NULL) {
-	Tcl_SetResult(interp, "error reading array statistics", TCL_STATIC);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
-    ckfree(stats);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ArrayUnsetCmd --
- *
- *	This object-based function is invoked to process the "array unset" Tcl
- *	command. See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result object.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-static int
-ArrayUnsetCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr, *arrayPtr, *varPtr2, *protectedVarPtr;
-    Tcl_Obj *varNameObj, *patternObj, *nameObj;
-    Tcl_HashSearch search;
-    const char *pattern;
-    const int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
-
-    switch (objc) {
-    case 2:
-	varNameObj = objv[1];
-	patternObj = NULL;
-	break;
-    case 3:
-	varNameObj = objv[1];
-	patternObj = objv[2];
-	break;
-    default:
-	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
+    varPtr = TclObjLookupVar(interp, arrayNameObj, NULL,
+	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
+	    /*createPart2*/ 0, &arrayPtr);
+    if (varPtr == NULL) {
 	return TCL_ERROR;
     }
 
-    /*
-     * Locate the array variable
-     */
-
-    varPtr = TclObjLookupVarEx(interp, varNameObj, 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.
-     */
-
-    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
-	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
-	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNameObj, NULL,
-		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
-		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
+    if (arrayElemObj != NULL) {
+	result = Tcl_ListObjGetElements(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);
 	    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.
-     */
-
-    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
-	    || TclIsVarUndefined(varPtr)) {
-	return TCL_OK;
-    }
-
-    if (!patternObj) {
-	/*
-	 * When no pattern is given, just unset the whole array.
-	 */
-
-	return TclObjUnsetVar2(interp, varNameObj, NULL, 0);
-    }
+	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.
+	     */
 
-    /*
-     * With a trivial pattern, we can just unset.
-     */
+	    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;
+		}
 
-    pattern = TclGetString(patternObj);
-    if (TclMatchIsTrivial(pattern)) {
-	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
-	if (!varPtr2 || TclIsVarUndefined(varPtr2)) {
-	    return TCL_OK;
+		/*
+		 * The TclPtrSetVar call might have shimmered
+		 * arrayElemObj to another type, so re-fetch
+		 * the pointers for safety.
+		 */
+		Tcl_ListObjGetElements(NULL, arrayElemObj,
+			&elemLen, &elemPtrs);
+	    }
+	    return result;
 	}
-	return TclPtrUnsetVar(interp, varPtr2, varPtr, varNameObj, patternObj,
-		unsetFlags, -1);
     }
-
+    
     /*
-     * 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]
+     * The list is empty make sure we have an array, or create
+     * one if necessary.
      */
-
-    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 (varPtr2 == protectedVarPtr) {
-	    VarHashRefCount(varPtr2)--;
-	}
-
-	/*
-	 * Guard the next (peeked) 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 (search.nextEntryPtr != NULL) {
-	    protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
-	    VarHashRefCount(protectedVarPtr)++;
-	} else {
-	    protectedVarPtr = NULL;
-	}
-
-	/*
-	 * If the variable is undefined, clean it out as it has been hit by
-	 * something else (i.e., an unset trace).
-	 */
-
-	if (TclIsVarUndefined(varPtr2)) {
-	    CleanupVar(varPtr2, varPtr);
-	    continue;
+    
+    if (varPtr != NULL) {
+	if (!TclIsVarUndefined(varPtr) && TclIsVarArray(varPtr)) {
+	    /*
+	     * Already an array, done.
+	     */
+	    
+	    return TCL_OK;
 	}
-
-	nameObj = VarHashGetKey(varPtr2);
-	if (Tcl_StringMatch(TclGetString(nameObj), pattern)
-		&& TclPtrUnsetVar(interp, varPtr2, varPtr, varNameObj,
-			nameObj, unsetFlags, -1) != TCL_OK) {
+	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
 	    /*
-	     * If we incremented a refcount, we must decrement it here as we
-	     * will not be coming back properly due to the error.
+	     * Either an array element, or a scalar: lose!
 	     */
-
-	    if (protectedVarPtr) {
-		VarHashRefCount(protectedVarPtr)--;
-		CleanupVar(protectedVarPtr, varPtr);
-	    }
+	    
+	    VarErrMsg(interp, varName, (char *)NULL, "array set", needArray);
 	    return TCL_ERROR;
 	}
     }
+    TclSetVarArray(varPtr);
+    TclClearVarUndefined(varPtr);
+    varPtr->value.tablePtr =
+	(Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+    Tcl_InitHashTable(varPtr->value.tablePtr, TCL_STRING_KEYS);
     return TCL_OK;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclInitArrayCmd --
- *
- *	This creates the ensemble for the "array" command.
- *
- * Results:
- *	The handle for the created ensemble.
- *
- * Side effects:
- *	Creates a command in the global namespace.
- *
- *----------------------------------------------------------------------
- */
-
-	/* ARGSUSED */
-Tcl_Command
-TclInitArrayCmd(
-    Tcl_Interp *interp)		/* Current interpreter. */
-{
-    static const EnsembleImplMap arrayImplMap[] = {
-	{"anymore",	ArrayAnyMoreCmd,	NULL, NULL, NULL, 0},
-	{"donesearch",	ArrayDoneSearchCmd,	NULL, NULL, NULL, 0},
-	{"exists",	ArrayExistsCmd,		NULL, NULL, NULL, 0},
-	{"get",		ArrayGetCmd,		NULL, NULL, NULL, 0},
-	{"names",	ArrayNamesCmd,		NULL, NULL, NULL, 0},
-	{"nextelement",	ArrayNextElementCmd,	NULL, NULL, NULL, 0},
-	{"set",		ArraySetCmd,		NULL, NULL, NULL, 0},
-	{"size",	ArraySizeCmd,		NULL, NULL, NULL, 0},
-	{"startsearch",	ArrayStartSearchCmd,	NULL, NULL, NULL, 0},
-	{"statistics",	ArrayStatsCmd,		NULL, NULL, NULL, 0},
-	{"unset",	ArrayUnsetCmd,		NULL, NULL, NULL, 0},
-	{NULL, NULL, NULL, NULL, NULL, 0}
-    };
-
-    return TclMakeEnsemble(interp, "array", arrayImplMap);
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * ObjMakeUpvar --
  *
- *	This function does all of the work of the "global" and "upvar"
+ *	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.
+ *	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
@@ -4258,43 +3547,40 @@ TclInitArrayCmd(
  */
 
 static int
-ObjMakeUpvar(
-    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
-				 * error messages, too. */
-    CallFrame *framePtr,	/* Call frame containing "other" variable.
+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.
 				 * 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. */
-    Tcl_Obj *myNamePtr,		/* Name of variable which will refer 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:
+    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, *arrayPtr;
+    Var *otherPtr, *varPtr, *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;
     }
@@ -4302,195 +3588,84 @@ ObjMakeUpvar(
 	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);
-	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", 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;
-    int result;
-
-    if (myName) {
-	myNamePtr = Tcl_NewStringObj(myName, -1);
-	Tcl_IncrRefCount(myNamePtr);
-    } else {
-	myNamePtr = NULL;
-    }
-    result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
-    if (myNamePtr) {
-	Tcl_DecrRefCount(myNamePtr);
-    }
-    return result;
-}
-
-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 (!HasLocalVars(varFramePtr)) {
-	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
+	if (!varFramePtr->isProcCallFrame) {
+	    panic("ObjMakeUpvar called with an index outside from a proc.\n");
 	}
-	varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
-	myNamePtr = localName(iPtr->varFramePtr, index);
-	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
+	varPtr = &(varFramePtr->compiledLocals[index]);
     } else {
 	/*
-	 * 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().
+	 * 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.
 	 */
-
-	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);
-		Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
-			NULL);
-		return TCL_ERROR;
-	    }
+	
+	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;
 	}
-
+	
 	/*
 	 * Lookup and eventually create the new variable. Set the flag bit
-	 * AVOID_RESOLVERS to indicate the special resolution rules for upvar
-	 * purposes:
+	 * LOOKUP_FOR_UPVAR 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, myNamePtr,
-		myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
+	
+	varPtr = TclLookupSimpleVar(interp, myName, (myFlags | LOOKUP_FOR_UPVAR), 
+	        /* create */ 1, &errMsg, &index);
 	if (varPtr == NULL) {
-	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
-	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
-		    TclGetString(myNamePtr), NULL);
+	    VarErrMsg(interp, myName, NULL, "create", errMsg);
 	    return TCL_ERROR;
 	}
     }
 
     if (varPtr == otherPtr) {
 	Tcl_SetResult((Tcl_Interp *) iPtr,
-		"can't upvar from variable to itself", TCL_STATIC);
-	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL);
+		      "can't upvar from variable to itself", TCL_STATIC);
 	return TCL_ERROR;
     }
 
-    if (TclIsVarTraced(varPtr)) {
+    if (varPtr->tracePtr != NULL) {
 	Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
-		"\" has traces: can't use for upvar", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", NULL);
+	        "\" has traces: can't use for upvar", (char *) NULL);
 	return TCL_ERROR;
     } else if (!TclIsVarUndefined(varPtr)) {
-	Var *linkPtr;
-
 	/*
 	 * 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)) {
-	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
-		    "\" already exists", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL);
-	    return TCL_ERROR;
-	}
-
-	linkPtr = varPtr->value.linkPtr;
-	if (linkPtr == otherPtr) {
-	    return TCL_OK;
-	}
-	if (TclIsVarInHash(linkPtr)) {
-	    VarHashRefCount(linkPtr)--;
+	if (TclIsVarLink(varPtr)) {
+	    Var *linkPtr = varPtr->value.linkPtr;
+	    if (linkPtr == otherPtr) {
+		return TCL_OK;
+	    }
+	    linkPtr->refCount--;
 	    if (TclIsVarUndefined(linkPtr)) {
-		CleanupVar(linkPtr, NULL);
+		CleanupVar(linkPtr, (Var *) NULL);
 	    }
+	} else {
+	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
+		    "\" already exists", (char *) NULL);
+	    return TCL_ERROR;
 	}
     }
     TclSetVarLink(varPtr);
+    TclClearVarUndefined(varPtr);
     varPtr->value.linkPtr = otherPtr;
-    if (TclIsVarInHash(otherPtr)) {
-	VarHashRefCount(otherPtr)++;
-    }
+    otherPtr->refCount++;
     return TCL_OK;
 }
 
@@ -4499,53 +3674,36 @@ TclPtrObjMakeUpvar(
  *
  * Tcl_UpVar --
  *
- *	This function links one variable to another, just like the "upvar"
- *	command.
+ *	This procedure 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 localNameStr, so that references to
- *	localNameStr are redirected to the other variable like a symbolic
+ *	accessible under the name localName, so that references to
+ *	localName are redirected to the other variable like a symbolic
  *	link.
  *
  *----------------------------------------------------------------------
  */
 
 int
-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
+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
 				 * 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 *localNameStr,	/* Name of link variable. */
-    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
-				 * indicates scope of localNameStr. */
+    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. */
 {
-    int result;
-    CallFrame *framePtr;
-    Tcl_Obj *varNamePtr, *localNamePtr;
-
-    if (TclGetFrame(interp, frameName, &framePtr) == -1) {
-	return TCL_ERROR;
-    }
-
-    varNamePtr = Tcl_NewStringObj(varName, -1);
-    Tcl_IncrRefCount(varNamePtr);
-    localNamePtr = Tcl_NewStringObj(localNameStr, -1);
-    Tcl_IncrRefCount(localNamePtr);
-
-    result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0,
-	    localNamePtr, flags, -1);
-    Tcl_DecrRefCount(varNamePtr);
-    Tcl_DecrRefCount(localNamePtr);
-    return result;
+    return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags);
 }
 
 /*
@@ -4553,38 +3711,38 @@ Tcl_UpVar(
  *
  * Tcl_UpVar2 --
  *
- *	This function links one variable to another, just like the "upvar"
- *	command.
+ *	This procedure 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 localNameStr, so that references to
- *	localNameStr 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(
-    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
-				 * error messages too. */
-    const char *frameName,	/* Name of the frame containing the source
+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
 				 * variable, such as "1" or "#0". */
-    const char *part1,
-    const char *part2,		/* Two parts of source variable name to link
-				 * to. */
-    const char *localNameStr,	/* Name of link variable. */
-    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
-				 * indicates scope of localNameStr. */
+    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, *localNamePtr;
+    Tcl_Obj *part1Ptr;
 
     if (TclGetFrame(interp, frameName, &framePtr) == -1) {
 	return TCL_ERROR;
@@ -4592,13 +3750,10 @@ Tcl_UpVar2(
 
     part1Ptr = Tcl_NewStringObj(part1, -1);
     Tcl_IncrRefCount(part1Ptr);
-    localNamePtr = Tcl_NewStringObj(localNameStr, -1);
-    Tcl_IncrRefCount(localNamePtr);
-
     result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
-	    localNamePtr, flags, -1);
-    Tcl_DecrRefCount(part1Ptr);
-    Tcl_DecrRefCount(localNamePtr);
+	    localName, flags, -1);
+    TclDecrRefCount(part1Ptr);
+
     return result;
 }
 
@@ -4607,60 +3762,51 @@ Tcl_UpVar2(
  *
  * Tcl_GetVariableFullName --
  *
- *	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.
+ *	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.
  *
  * 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(
-    Tcl_Interp *interp,		/* Interpreter containing the variable. */
-    Tcl_Var variable,		/* Token for the variable returned by a
+Tcl_GetVariableFullName(interp, variable, objPtr)
+    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;
-    Tcl_Obj *namePtr;
-    Namespace *nsPtr;
-
-    if (!varPtr || TclIsVarArrayElement(varPtr)) {
-	return;
-    }
+    char *name;
 
     /*
-     * 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.
      */
 
-    nsPtr = TclGetVarNsPtr(varPtr);
-    if (nsPtr) {
-	Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
-	if (nsPtr != iPtr->globalNsPtr) {
-	    Tcl_AppendToObj(objPtr, "::", 2);
-	}
-    }
-    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);
+    if (varPtr != NULL) {
+	if (!TclIsVarArrayElement(varPtr)) {
+	    if (varPtr->nsPtr != NULL) {
+		Tcl_AppendToObj(objPtr, varPtr->nsPtr->fullName, -1);
+		if (varPtr->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);
+	    }
 	}
     }
 }
@@ -4670,7 +3816,7 @@ Tcl_GetVariableFullName(
  *
  * Tcl_GlobalObjCmd --
  *
- *	This object-based function is invoked to process the "global" Tcl
+ *	This object-based procedure is invoked to process the "global" Tcl
  *	command. See the user documentation for details on what it does.
  *
  * Results:
@@ -4683,68 +3829,63 @@ Tcl_GetVariableFullName(
  */
 
 int
-Tcl_GlobalObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
-    register Tcl_Obj *objPtr, *tailPtr;
-    const char *varName;
-    register const char *tail;
+    register Tcl_Obj *objPtr;
+    char *varName;
+    register char *tail;
     int result, i;
 
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
+	return TCL_ERROR;
+    }
+
     /*
      * If we are not executing inside a Tcl procedure, just return.
      */
-
-    if (!HasLocalVars(iPtr->varFramePtr)) {
+    
+    if ((iPtr->varFramePtr == NULL)
+	    || !iPtr->varFramePtr->isProcCallFrame) {
 	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--;
-	}
-	if ((*tail == ':') && (tail > varName)) {
-	    tail++;
+        while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
+            tail--;
 	}
-
-	if (tail == varName) {
-	    tailPtr = objPtr;
-	} else {
-	    tailPtr = Tcl_NewStringObj(tail, -1);
-	    Tcl_IncrRefCount(tailPtr);
+        if ((*tail == ':') && (tail > varName)) {
+            tail++;
 	}
 
 	/*
 	 * Link to the variable "varName" in the global :: namespace.
 	 */
-
-	result = ObjMakeUpvar(interp, NULL, objPtr, NULL,
-		TCL_GLOBAL_ONLY, /*myName*/ tailPtr, /*myFlags*/ 0, -1);
-
-	if (tail != varName) {
-	    Tcl_DecrRefCount(tailPtr);
-	}
-
+	
+	result = ObjMakeUpvar(interp, (CallFrame *) NULL,
+		objPtr, NULL, /*otherFlags*/ TCL_GLOBAL_ONLY,
+	        /*myName*/ tail, /*myFlags*/ 0, -1);
 	if (result != TCL_OK) {
 	    return result;
 	}
@@ -4767,96 +3908,104 @@ Tcl_GlobalObjCmd(
  *	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 function returns an error message as the
- *	result in the interpreter's result object.
+ *	If anything goes wrong, this procedure returns an error message
+ *	as the result in the interpreter's result object.
  *
  *----------------------------------------------------------------------
  */
 
 int
-Tcl_VariableObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     Interp *iPtr = (Interp *) interp;
-    const char *varName, *tail, *cp;
+    char *varName, *tail, *cp;
     Var *varPtr, *arrayPtr;
     Tcl_Obj *varValuePtr;
     int i, result;
-    Tcl_Obj *varNamePtr, *tailPtr;
+    Tcl_Obj *varNamePtr;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
+	return TCL_ERROR;
+    }
 
-    for (i=1 ; i<objc ; i+=2) {
+    for (i = 1;  i < objc;  i = 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 = 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);
-	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
-	    return TCL_ERROR;
-	}
+	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;
+        }
 
 	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.
 	 */
 
-	TclSetVarNamespaceVar(varPtr);
+	if (!(varPtr->flags & VAR_NAMESPACE_VAR)) {
+	    varPtr->flags |= VAR_NAMESPACE_VAR;
+	    varPtr->refCount++;
+	}
 
 	/*
 	 * 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, varNamePtr,
-		    NULL, objv[i+1], TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG,-1);
+	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 (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 (HasLocalVars(iPtr->varFramePtr)) {
+	if ((iPtr->varFramePtr != NULL)
+	        && iPtr->varFramePtr->isProcCallFrame) {
 	    /*
 	     * varName might have a scope qualifier, but the name for the
 	     * local "link" variable must be the simple name at the tail.
@@ -4865,34 +4014,23 @@ Tcl_VariableObjCmd(
 	     * 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.
 	     */
-
-	    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);
-	    }
-
+	    
+	    result = ObjMakeUpvar(interp, (CallFrame *) NULL,
+		    /*otherP1*/ varNamePtr, /*otherP2*/ NULL,
+                    /*otherFlags*/ TCL_NAMESPACE_ONLY,
+		    /*myName*/ tail, /*myFlags*/ 0, -1);
 	    if (result != TCL_OK) {
 		return result;
 	    }
@@ -4906,8 +4044,8 @@ Tcl_VariableObjCmd(
  *
  * Tcl_UpvarObjCmd --
  *
- *	This object-based function is invoked to process the "upvar" Tcl
- *	command. See the user documentation for details on what it does.
+ *	This object-based procedure 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.
@@ -4920,81 +4058,347 @@ Tcl_VariableObjCmd(
 
 	/* ARGSUSED */
 int
-Tcl_UpvarObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+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. */
 {
     CallFrame *framePtr;
-    int result, hasLevel;
-    Tcl_Obj *levelObj;
+    char *frameSpec, *localName;
+    int result;
 
     if (objc < 3) {
+	upvarSyntax:
 	Tcl_WrongNumArgs(interp, 1, objv,
 		"?level? otherVar localVar ?otherVar localVar ...?");
 	return TCL_ERROR;
     }
 
-    if (objc & 1) {
-	/*
-	 * Even number of arguments, so use the default level of "1" by
-	 * passing NULL to TclObjGetFrame.
-	 */
+    /*
+     * Find the call frame containing each of the "other variables" to be
+     * linked to. 
+     */
 
-	levelObj = NULL;
-	hasLevel = 0;
-    } else {
-	/*
-	 * Odd number of arguments, so objv[1] must contain the level.
-	 */
+    frameSpec = TclGetString(objv[1]);
+    result = TclGetFrame(interp, frameSpec, &framePtr);
+    if (result == -1) {
+	return TCL_ERROR;
+    }
+    objc -= result+1;
+    if ((objc & 1) != 0) {
+	goto upvarSyntax;
+    }
+    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.
+     */
+
+    for ( ;  objc > 0;  objc -= 2, objv += 2) {
+	localName = TclGetString(objv[1]);
+	result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
+		NULL, 0, /* myVarName */ localName, /*flags*/ 0, -1);
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
 
-	levelObj = objv[1];
-	hasLevel = 1;
+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);
 
     /*
-     * Find the call frame containing each of the "other variables" to be
-     * linked to.
+     * If there are already similar trace procedures active for the
+     * variable, don't call them again.
      */
 
-    result = TclObjGetFrame(interp, levelObj, &framePtr);
-    if (result == -1) {
-	return TCL_ERROR;
+    if (varPtr->flags & VAR_TRACE_ACTIVE) {
+	return code;
+    }
+    varPtr->flags |= VAR_TRACE_ACTIVE;
+    varPtr->refCount++;
+    if (arrayPtr != NULL) {
+	arrayPtr->refCount++;
     }
-    if ((result == 0) && hasLevel) {
-	/*
-	 * Synthesize an error message since TclObjGetFrame doesn't do this
-	 * for this particular case.
-	 */
 
-	Tcl_AppendResult(interp, "bad level \"", TclGetString(levelObj), "\"",
-		NULL);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LEVEL", NULL);
-	return TCL_ERROR;
+    /*
+     * 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;
+	    }
+	}
     }
 
     /*
-     * We've now finished with parsing levels; skip to the variable names.
+     * Invoke traces on the array containing the variable, if relevant.
      */
 
-    objc -= hasLevel+1;
-    objv += hasLevel+1;
+    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;
+	    }
+	}
+    }
 
     /*
-     * 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.
+     * Invoke traces on the variable itself.
      */
 
-    for (; objc>0 ; objc-=2, objv+=2) {
-	result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
-		NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1);
-	if (result != TCL_OK) {
-	    return TCL_ERROR;
+    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;
 	}
     }
-    return TCL_OK;
+
+    /*
+     * 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;
 }
 
 /*
@@ -5002,28 +4406,29 @@ Tcl_UpvarObjCmd(
  *
  * 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(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr)
+SetArraySearchObj(interp, objPtr)
+    Tcl_Interp *interp;
+    Tcl_Obj *objPtr;
 {
-    const char *string;
-    char *end;			/* Can't be const due to strtoul defn. */
+    char *string;
+    char *end;
     int id;
     size_t offset;
 
@@ -5031,39 +4436,35 @@ SetArraySearchObj(
      * Get the string representation. Make it up-to-date if necessary.
      */
 
-    string = TclGetString(objPtr);
+    string = Tcl_GetString(objPtr);
 
     /*
      * Parse the id into the three parts separated by dashes.
      */
-
     if ((string[0] != 's') || (string[1] != '-')) {
-	goto syntax;
+	syntax:
+	Tcl_AppendResult(interp, "illegal search identifier \"", string,
+		"\"", (char *) NULL);
+	return TCL_ERROR;
     }
     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;
 
-    TclFreeIntRep(objPtr);
+    if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
+	objPtr->typePtr->freeIntRepProc(objPtr);
+    }
     objPtr->typePtr = &tclArraySearchType;
-    objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id);
-    objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset);
+    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *)(((char *)NULL)+id);
+    objPtr->internalRep.twoPtrValue.ptr2 = (VOID *)(((char *)NULL)+offset);
     return TCL_OK;
-
-  syntax:
-    Tcl_AppendResult(interp, "illegal search identifier \"", string, "\"",
-	    NULL);
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
-    return TCL_ERROR;
 }
 
 /*
@@ -5071,13 +4472,13 @@ SetArraySearchObj(
  *
  * ParseSearchId --
  *
- *	This function translates from a tcl object to a pointer to an active
- *	array search (if there is one that matches the string).
+ *	This procedure 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
@@ -5087,75 +4488,62 @@ SetArraySearchObj(
  */
 
 static ArraySearch *
-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
+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
 				 * 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 const char *string;
+    register char *string;
     register size_t offset;
     int id;
     ArraySearch *searchPtr;
-    const char *varName = TclGetString(varNamePtr);
 
     /*
      * Parse the id.
      */
-
     if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
 	return NULL;
     }
-
     /*
-     * Extract the information out of the Tcl_Obj.
+     * Cast is safe, since always came from an int in the first place.
      */
-
-    id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1);
-    string = TclGetString(handleObj);
-    offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2);
-
+    id = (int)(((char*)handleObj->internalRep.twoPtrValue.ptr1) -
+	       ((char*)NULL));
+    string = Tcl_GetString(handleObj);
+    offset = (((char*)handleObj->internalRep.twoPtrValue.ptr2) -
+	      ((char*)NULL));
     /*
-     * 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, "\"", NULL);
-	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string,
-		NULL);
-	goto badLookup;
+		"\" isn't for variable \"", varName, "\"", (char *) NULL);
+	return NULL;
     }
 
     /*
-     * 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.
      */
 
-    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
-	Tcl_HashEntry *hPtr =
-		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
-
-	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
-		searchPtr = searchPtr->nextPtr) {
-	    if (searchPtr->id == id) {
-		return searchPtr;
-	    }
+    for (searchPtr = varPtr->searchPtr; searchPtr != NULL;
+	 searchPtr = searchPtr->nextPtr) {
+	if (searchPtr->id == id) {
+	    return searchPtr;
 	}
     }
-    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
-  badLookup:
-    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
+    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"",
+	    (char *) NULL);
     return NULL;
 }
 
@@ -5164,8 +4552,8 @@ ParseSearchId(
  *
  * DeleteSearches --
  *
- *	This function is called to free up all of the searches associated
- *	with an array variable.
+ *	This procedure is called to free up all of the searches
+ *	associated with an array variable.
  *
  * Results:
  *	None.
@@ -5177,23 +4565,16 @@ ParseSearchId(
  */
 
 static void
-DeleteSearches(
-    Interp *iPtr,
-    register Var *arrayVarPtr)	/* Variable whose searches are to be
-				 * deleted. */
+DeleteSearches(arrayVarPtr)
+    register Var *arrayVarPtr;		/* Variable whose searches are
+					 * to be deleted. */
 {
-    ArraySearch *searchPtr, *nextPtr;
-    Tcl_HashEntry *sPtr;
-
-    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
-	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
-	for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
-		searchPtr = nextPtr) {
-	    nextPtr = searchPtr->nextPtr;
-	    ckfree(searchPtr);
-	}
-	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
-	Tcl_DeleteHashEntry(sPtr);
+    ArraySearch *searchPtr;
+
+    while (arrayVarPtr->searchPtr != NULL) {
+	searchPtr = arrayVarPtr->searchPtr;
+	arrayVarPtr->searchPtr = searchPtr->nextPtr;
+	ckfree((char *) searchPtr);
     }
 }
 
@@ -5202,118 +4583,108 @@ DeleteSearches(
  *
  * TclDeleteNamespaceVars --
  *
- *	This function is called to recycle all the storage space associated
- *	with a namespace's table of variables.
+ *	This procedure 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 functions are invoked, if any are
- *	declared.
+ *	Variables are deleted and trace procedures are invoked, if
+ *	any are declared.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclDeleteNamespaceVars(
-    Namespace *nsPtr)
+TclDeleteNamespaceVars(nsPtr)
+    Namespace *nsPtr;
 {
-    TclVarHashTable *tablePtr = &nsPtr->varTable;
+    Tcl_HashTable *tablePtr = &nsPtr->varTable;
     Tcl_Interp *interp = nsPtr->interp;
     Interp *iPtr = (Interp *)interp;
     Tcl_HashSearch search;
+    Tcl_HashEntry *hPtr;
     int flags = 0;
-    Var *varPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
 
     /*
-     * Determine what flags to pass to the trace callback functions.
+     * Determine what flags to pass to the trace callback procedures.
      */
 
     if (nsPtr == iPtr->globalNsPtr) {
 	flags = TCL_GLOBAL_ONLY;
-    } else if (nsPtr == (Namespace *) TclGetCurrentNamespace(interp)) {
+    } else if (nsPtr == currNsPtr) {
 	flags = TCL_NAMESPACE_ONLY;
     }
 
-    for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
-	    varPtr = VarHashFirstVar(tablePtr, &search)) {
+    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search);  hPtr != NULL;
+	 hPtr = Tcl_FirstHashEntry(tablePtr, &search)) {
+	register Var *varPtr = (Var *) Tcl_GetHashValue(hPtr);
 	Tcl_Obj *objPtr = Tcl_NewObj();
-
-	Tcl_IncrRefCount(objPtr);
-	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
-					 * hash. */
+	varPtr->refCount++;	/* Make sure we get to remove from hash */
+	Tcl_IncrRefCount(objPtr); 
 	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
-	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags,
-		-1);
-	Tcl_DecrRefCount(objPtr);	/* Free no longer needed obj */
-
-	/*
-	 * Remove the variable from the table and force it undefined in case
-	 * an unset trace brought it back from the dead.
-	 */
-
-	if (TclIsVarTraced(varPtr)) {
-	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
-	    VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
-	    ActiveVarTrace *activePtr;
-
-	    while (tracePtr) {
-		VarTrace *prevPtr = tracePtr;
+	UnsetVarStruct(varPtr, NULL, iPtr, Tcl_GetString(objPtr), NULL, flags);
+	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
+	varPtr->refCount--;
 
-		tracePtr = tracePtr->nextPtr;
-		prevPtr->nextPtr = NULL;
-		Tcl_EventuallyFree(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;
-		}
-	    }
+	/* 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);
 	}
-	VarHashRefCount(varPtr)--;
-	VarHashDeleteEntry(varPtr);
+	CleanupVar(varPtr, NULL);
     }
-    VarHashDeleteTable(tablePtr);
+    Tcl_DeleteHashTable(tablePtr);
 }
+
 
 /*
  *----------------------------------------------------------------------
  *
  * TclDeleteVars --
  *
- *	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).
+ *	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).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Variables are deleted and trace functions are invoked, if any are
- *	declared.
+ *	Variables are deleted and trace procedures are invoked, if
+ *	any are declared.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclDeleteVars(
-    Interp *iPtr,		/* Interpreter to which variables belong. */
-    TclVarHashTable *tablePtr)	/* Hash table containing variables to
+TclDeleteVars(iPtr, tablePtr)
+    Interp *iPtr;		/* Interpreter to which variables belong. */
+    Tcl_HashTable *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;
-    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+    ActiveVarTrace *activePtr;
+    Tcl_Obj *objPtr;
+    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
 
     /*
-     * Determine what flags to pass to the trace callback functions.
+     * Determine what flags to pass to the trace callback procedures.
      */
 
     flags = TCL_TRACE_UNSETS;
@@ -5323,13 +4694,102 @@ TclDeleteVars(
 	flags |= TCL_NAMESPACE_ONLY;
     }
 
-    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
-	 varPtr = VarHashFirstVar(tablePtr, &search)) {
-	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
-		-1);
-	VarHashDeleteEntry(varPtr);
+    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);
+		}
+	    }
+	}
+
+	/*
+	 * 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 */
+	}
     }
-    VarHashDeleteTable(tablePtr);
+    Tcl_DeleteHashTable(tablePtr);
 }
 
 /*
@@ -5337,41 +4797,104 @@ TclDeleteVars(
  *
  * TclDeleteCompiledLocalVars --
  *
- *	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).
+ *	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).
  *
  * Results:
  *	None.
  *
  * Side effects:
- *	Variables are deleted and trace functions are invoked, if any are
- *	declared.
+ *	Variables are deleted and trace procedures are invoked, if
+ *	any are declared.
  *
  *----------------------------------------------------------------------
  */
 
 void
-TclDeleteCompiledLocalVars(
-    Interp *iPtr,		/* Interpreter to which variables belong. */
-    CallFrame *framePtr)	/* Procedure call frame containing compiler-
-				 * assigned local variables to delete. */
+TclDeleteCompiledLocalVars(iPtr, framePtr)
+    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;
-    namePtrPtr = &localName(framePtr, 0);
-    for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
-	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
-		TCL_TRACE_UNSETS, i);
+    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++;
     }
-    framePtr->numCompiledLocals = 0;
 }
 
 /*
@@ -5379,1102 +4902,430 @@ TclDeleteCompiledLocalVars(
  *
  * DeleteArray --
  *
- *	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.
+ *	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.
  *
  * Results:
  *	None.
  *
  * Side effects:
  *	All storage associated with varPtr's array elements is 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.
+ *	(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.
  *
  *----------------------------------------------------------------------
  */
 
 static void
-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. */
-    int index)
+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. */
 {
     Tcl_HashSearch search;
-    Tcl_HashEntry *tPtr;
+    register Tcl_HashEntry *hPtr;
     register Var *elPtr;
     ActiveVarTrace *activePtr;
     Tcl_Obj *objPtr;
-    VarTrace *tracePtr;
 
-    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
-	DeleteSearches(iPtr, varPtr);
-    }
-    for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search);
-	    elPtr != NULL; elPtr = VarHashNextVar(&search)) {
+    DeleteSearches(varPtr);
+    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
+	 hPtr != NULL;  hPtr = Tcl_NextHashEntry(&search)) {
+	elPtr = (Var *) Tcl_GetHashValue(hPtr);
 	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
 	    objPtr = elPtr->value.objPtr;
 	    TclDecrRefCount(objPtr);
 	    elPtr->value.objPtr = NULL;
 	}
-
-	/*
-	 * 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, index);
+	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);
 	    }
-	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
-	    tracePtr = Tcl_GetHashValue(tPtr);
-	    while (tracePtr) {
-		VarTrace *prevPtr = tracePtr;
-
-		tracePtr = tracePtr->nextPtr;
-		prevPtr->nextPtr = NULL;
-		Tcl_EventuallyFree(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. 
 	 */
 
-	TclClearVarNamespaceVar(elPtr);
+	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 */
+	}
     }
-    VarHashDeleteTable(varPtr->value.tablePtr);
-    ckfree(varPtr->value.tablePtr);
+    Tcl_DeleteHashTable(varPtr->value.tablePtr);
+    ckfree((char *) varPtr->value.tablePtr);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclObjVarErrMsg --
+ * CleanupVar --
  *
- *	Generate a reasonable error message describing why a variable
- *	operation failed.
+ *	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.
  *
  * 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.
- *
- *----------------------------------------------------------------------
- */
-
-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. */
-{
-    Tcl_Obj *part1Ptr = NULL, *part2Ptr = NULL;
-
-    part1Ptr = Tcl_NewStringObj(part1, -1);
-    Tcl_IncrRefCount(part1Ptr);
-    if (part2) {
-	part2Ptr = Tcl_NewStringObj(part2, -1);
-	Tcl_IncrRefCount(part2Ptr);
-    } else {
-	part2 = NULL;
-    }
-
-    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, operation, reason, -1);
-
-    Tcl_DecrRefCount(part1Ptr);
-    if (part2Ptr) {
-	Tcl_DecrRefCount(part2Ptr);
-    }
-}
-
-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. */
-{
-    if (!part1Ptr) {
-	if (index == -1) {
-	    Tcl_Panic("invalid part1Ptr and invalid index together");
-	}
-	part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
-    }
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s",
-	    operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""),
-	    (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""),
-	    reason));
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Internal functions for variable name object types --
+ *	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.
  *
  *----------------------------------------------------------------------
  */
 
-/*
- * Panic functions that should never be called in normal operation.
- */
-
 static void
-PanicOnUpdateVarName(
-    Tcl_Obj *objPtr)
+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. */
 {
-    Tcl_Panic("%s of type %s should not be called", "updateStringProc",
-	    objPtr->typePtr->name);
-}
-
-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;
-}
-
-/*
- * localVarName -
- *
- * INTERNALREP DEFINITION:
- *   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
-FreeLocalVarName(
-    Tcl_Obj *objPtr)
-{
-    Tcl_Obj *namePtr = objPtr->internalRep.ptrAndLongRep.ptr;
-
-    if (namePtr) {
-	Tcl_DecrRefCount(namePtr);
-    }
-    objPtr->typePtr = NULL;
-}
-
-static void
-DupLocalVarName(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *dupPtr)
-{
-    Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr;
-
-    if (!namePtr) {
-	namePtr = srcPtr;
-    }
-    dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
-    Tcl_IncrRefCount(namePtr);
-
-    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
- */
-
-static void
-FreeNsVarName(
-    Tcl_Obj *objPtr)
-{
-    register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2;
-
-    if (TclIsVarInHash(varPtr)) {
-	varPtr->refCount--;
-	if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
-	    CleanupVar(varPtr, NULL);
+    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);
     }
-    objPtr->typePtr = NULL;
-}
-
-static void
-DupNsVarName(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *dupPtr)
-{
-    Namespace *nsPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-    register Var *varPtr = srcPtr->internalRep.twoPtrValue.ptr2;
-
-    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
- */
-
-static void
-FreeParsedVarName(
-    Tcl_Obj *objPtr)
-{
-    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(
-    Tcl_Obj *srcPtr,
-    Tcl_Obj *dupPtr)
-{
-    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-    register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
-    char *elemCopy;
-    unsigned elemLen;
-
-    if (arrayPtr != NULL) {
-	Tcl_IncrRefCount(arrayPtr);
-	elemLen = strlen(elem);
-	elemCopy = ckalloc(elemLen + 1);
-	memcpy(elemCopy, elem, elemLen);
-	*(elemCopy + elemLen) = '\0';
-	elem = elemCopy;
+	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);
+	}
     }
-
-    dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
-    dupPtr->internalRep.twoPtrValue.ptr2 = elem;
-    dupPtr->typePtr = &tclParsedVarNameType;
 }
-
-static void
-UpdateParsedVarName(
-    Tcl_Obj *objPtr)
-{
-    Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
-    const char *part1;
-    char *p;
-    int len1, len2, totalLen;
-
-    if (arrayPtr == NULL) {
-	/*
-	 * This is a parsed scalar name: what is it doing here?
-	 */
-
-	Tcl_Panic("scalar parsedVarName without a string rep");
-    }
-
-    part1 = TclGetStringFromObj(arrayPtr, &len1);
-    len2 = strlen(part2);
-
-    totalLen = len1 + len2 + 2;
-    p = ckalloc(totalLen + 1);
-    objPtr->bytes = p;
-    objPtr->length = totalLen;
-
-    memcpy(p, part1, (unsigned) len1);
-    p += len1;
-    *p++ = '(';
-    memcpy(p, part2, (unsigned) len2);
-    p += len2;
-    *p++ = ')';
-    *p = '\0';
-}
-
 /*
  *----------------------------------------------------------------------
  *
- * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
+ * VarErrMsg --
  *
- *	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.
+ *      Generate a reasonable error message describing why a variable
+ *      operation failed.
  *
  * 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.
+ *      None.
  *
  * Side effects:
- *	None.
+ *      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.
  *
  *----------------------------------------------------------------------
  */
 
-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;
-
-    Tcl_IncrRefCount(namePtr);
-    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. */
+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. */
 {
-    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;
-    const 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 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);
-	Tcl_IncrRefCount(simpleNamePtr);
-    } 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);
+    Tcl_ResetResult(interp);
+    Tcl_AppendResult(interp, "can't ", operation, " \"", part1,
+	    (char *) NULL);
+    if (part2 != NULL) {
+        Tcl_AppendResult(interp, "(", part2, ")", (char *) NULL);
     }
-    return (Tcl_Var) varPtr;
+    Tcl_AppendResult(interp, "\": ", reason, (char *) NULL);
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * InfoVarsCmd -- (moved over from tclCmdIL.c)
+ * TclTraceVarExists --
  *
- *	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?
+ *	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:
- *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *	A pointer to the Var structure, or NULL.
  *
  * Side effects:
- *	Returns a result in the interpreter's result object. If there is an
- *	error, the result is an error message.
+ *	May fill in error messages in the interp.
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclInfoVarsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+Var *
+TclVarTraceExists(interp, varName)
+    Tcl_Interp *interp;		/* The interpreter */
+    CONST char *varName;	/* The variable name */
 {
-    Interp *iPtr = (Interp *) interp;
-    const char *varName, *pattern, *simplePattern;
-    Tcl_HashSearch search;
     Var *varPtr;
-    Namespace *nsPtr;
-    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
-    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
-    Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
-    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
-    Tcl_Obj *simplePatternPtr = NULL;
+    Var *arrayPtr;
 
     /*
-     * 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.
+     * 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.
      */
 
-    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.
-	 */
+    varPtr = TclLookupVar(interp, varName, (char *) NULL,
+            0, "access", /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
 
-	Namespace *dummy1NsPtr, *dummy2NsPtr;
-
-	pattern = TclGetString(objv[1]);
-	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0,
-		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+    if (varPtr == NULL) {
+	return NULL;
+    }
 
-	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 ((varPtr->tracePtr != NULL)
+	    || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL))) {
+	CallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
+		TCL_TRACE_READS, /* leaveErrMsg */ 0);
     }
 
     /*
-     * If the namespace specified in the pattern wasn't found, just return.
+     * If the variable doesn't exist anymore and no-one's using
+     * it, then free up the relevant structures and hash table entries.
      */
 
-    if (nsPtr == NULL) {
-	return TCL_OK;
-    }
-
-    listPtr = Tcl_NewListObj(0, NULL);
-
-    if (!HasLocalVars(iPtr->varFramePtr) || 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 (iPtr->varFramePtr->procPtr != NULL) {
-	AppendLocals(interp, listPtr, simplePatternPtr, 1);
+    if (TclIsVarUndefined(varPtr)) {
+	CleanupVar(varPtr, arrayPtr);
+	return NULL;
     }
 
-    if (simplePatternPtr) {
-	Tcl_DecrRefCount(simplePatternPtr);
-    }
-    Tcl_SetObjResult(interp, listPtr);
-    return TCL_OK;
+    return varPtr;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * 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.
+ * Internal functions for variable name object types --
  *
  *----------------------------------------------------------------------
  */
 
-int
-TclInfoGlobalsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    const 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.
+/* 
+ * localVarName -
  *
- *----------------------------------------------------------------------
- */
+ * INTERNALREP DEFINITION:
+ *   twoPtrValue.ptr1 = pointer to the corresponding Proc 
+ *   twoPtrValue.ptr2 = index into locals table
+*/
 
-int
-TclInfoLocalsCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
+static void 
+FreeLocalVarName(objPtr)
+    Tcl_Obj *objPtr;
 {
-    Interp *iPtr = (Interp *) interp;
-    Tcl_Obj *patternPtr, *listPtr;
-
-    if (objc == 1) {
-	patternPtr = NULL;
-    } else if (objc == 2) {
-	patternPtr = objv[1];
-    } else {
-	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
-	return TCL_ERROR;
+    register Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
+    procPtr->refCount--;
+    if (procPtr->refCount <= 0) {
+	TclProcCleanupProc(procPtr);
     }
-
-    if (!HasLocalVars(iPtr->varFramePtr)) {
-	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. */
+DupLocalVarName(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;
+    Tcl_Obj *dupPtr;
 {
-    Interp *iPtr = (Interp *) interp;
-    Var *varPtr;
-    int i, localVarCt, added;
-    Tcl_Obj **varNamePtr, *objNamePtr;
-    const char *varName;
-    TclVarHashTable *localVarTablePtr;
-    Tcl_HashSearch search;
-    Tcl_HashTable addedTable;
-    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;
+    register Proc *procPtr = (Proc *) srcPtr->internalRep.twoPtrValue.ptr1;
 
-    localVarCt = iPtr->varFramePtr->numCompiledLocals;
-    varPtr = iPtr->varFramePtr->compiledLocals;
-    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
-    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
-    if (includeLinks) {
-	Tcl_InitObjHashTable(&addedTable);
-    }
-
-    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);
-		if (includeLinks) {
-		    Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
-		}
-	    }
-	}
-	varPtr++;
-    }
+    dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) procPtr;
+    dupPtr->internalRep.twoPtrValue.ptr2 = srcPtr->internalRep.twoPtrValue.ptr2;
+    procPtr->refCount++;
+    dupPtr->typePtr = &tclLocalVarNameType;
+}
 
-    /*
-     * Do nothing if no local variables.
-     */
+static void
+UpdateLocalVarName(objPtr)
+    Tcl_Obj *objPtr;
+{
+    Proc *procPtr = (Proc *) objPtr->internalRep.twoPtrValue.ptr1;
+    unsigned int index = (unsigned int) objPtr->internalRep.twoPtrValue.ptr2;
+    CompiledLocal *localPtr = procPtr->firstLocalPtr;
+    unsigned int nameLen;
 
-    if (localVarTablePtr == NULL) {
-	goto objectVars;
+    if (localPtr == NULL) {
+	goto emptyName;
     }
-
-    /*
-     * 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));
-		if (includeLinks) {
-		    Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
-			    &added);
-		}
-	    }
+    while (index--) {
+	localPtr = localPtr->nextPtr;
+	if (localPtr == NULL) {
+	    goto emptyName;
 	}
-	goto objectVars;
     }
 
-    /*
-     * Scan over and process all local variables.
-     */
+    nameLen = (unsigned int) localPtr->nameLength;
+    objPtr->bytes = ckalloc(nameLen + 1);
+    memcpy(objPtr->bytes, localPtr->name, nameLen + 1);
+    objPtr->length = nameLen;
+    return;
 
-    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);
-		if (includeLinks) {
-		    Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
-		}
-	    }
-	}
-    }
-
-  objectVars:
-    if (!includeLinks) {
-	return;
-    }
+    emptyName:
+    objPtr->bytes = ckalloc(1);
+    *(objPtr->bytes) = '\0';
+    objPtr->length = 0;
+}
 
-    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
-	CallContext *contextPtr = iPtr->varFramePtr->clientData;
-	Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+/* 
+ * nsVarName -
+ *
+ * INTERNALREP DEFINITION:
+ *   twoPtrValue.ptr1: pointer to the namespace containing the 
+ *                     reference.
+ *   twoPtrValue.ptr2: pointer to the corresponding Var 
+*/
 
-	if (mPtr->declaringObjectPtr) {
-	    FOREACH(objNamePtr, mPtr->declaringObjectPtr->variables) {
-		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
-		if (added && (!pattern ||
-			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
-		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
-		}
-	    }
-	} else {
-	    FOREACH(objNamePtr, mPtr->declaringClassPtr->variables) {
-		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
-		if (added && (!pattern ||
-			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
-		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
-		}
+static void 
+FreeNsVarName(objPtr)
+    Tcl_Obj *objPtr;
+{
+    register Var *varPtr = (Var *) 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);
 	    }
 	}
+	CleanupVar(varPtr, NULL);
     }
-    Tcl_DeleteHashTable(&addedTable);
-}
-
-/*
- * 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. */
+static void
+DupNsVarName(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;
+    Tcl_Obj *dupPtr;
 {
-    Tcl_Obj *objPtr = keyPtr;
-    Tcl_HashEntry *hPtr;
-    Var *varPtr;
+    Namespace *nsPtr = (Namespace *) srcPtr->internalRep.twoPtrValue.ptr1;
+    register Var *varPtr = (Var *) srcPtr->internalRep.twoPtrValue.ptr2;
 
-    varPtr = ckalloc(sizeof(VarInHash));
-    varPtr->flags = VAR_IN_HASHTABLE;
-    varPtr->value.objPtr = NULL;
-    VarHashRefCount(varPtr) = 1;
+    dupPtr->internalRep.twoPtrValue.ptr1 =  (VOID *) nsPtr;
+    dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) varPtr;
+    varPtr->refCount++;
+    dupPtr->typePtr = &tclNsVarNameType;
+}
 
-    hPtr = &(((VarInHash *) varPtr)->entry);
-    Tcl_SetHashValue(hPtr, varPtr);
-    hPtr->key.objPtr = objPtr;
-    Tcl_IncrRefCount(objPtr);
+/* 
+ * 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
+ */
 
-    return hPtr;
+static void 
+FreeParsedVarName(objPtr)
+    Tcl_Obj *objPtr;
+{
+    register Tcl_Obj *arrayPtr =
+	    (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
+    register char *elem = (char *) objPtr->internalRep.twoPtrValue.ptr2;
+    
+    if (arrayPtr != NULL) {
+	TclDecrRefCount(arrayPtr);
+	ckfree(elem);
+    }
 }
 
 static void
-FreeVarEntry(
-    Tcl_HashEntry *hPtr)
+DupParsedVarName(srcPtr, dupPtr)
+    Tcl_Obj *srcPtr;
+    Tcl_Obj *dupPtr;
 {
-    Var *varPtr = VarHashGetValue(hPtr);
-    Tcl_Obj *objPtr = hPtr->key.objPtr;
+    register Tcl_Obj *arrayPtr =
+	    (Tcl_Obj *) srcPtr->internalRep.twoPtrValue.ptr1;
+    register char *elem = (char *) srcPtr->internalRep.twoPtrValue.ptr2;
+    char *elemCopy;
+    unsigned int elemLen;
 
-    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
-	    && (VarHashRefCount(varPtr) == 1)) {
-	ckfree(varPtr);
-    } else {
-	VarHashInvalidateEntry(varPtr);
-	TclSetVarUndefined(varPtr);
-	VarHashRefCount(varPtr)--;
+    if (arrayPtr != NULL) {
+	Tcl_IncrRefCount(arrayPtr);
+	elemLen = strlen(elem);
+	elemCopy = ckalloc(elemLen+1);
+	memcpy(elemCopy, elem, elemLen);
+	*(elemCopy + elemLen) = '\0';
+	elem = elemCopy;
     }
-    Tcl_DecrRefCount(objPtr);
+
+    dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *) arrayPtr;
+    dupPtr->internalRep.twoPtrValue.ptr2 = (VOID *) elem;
+    dupPtr->typePtr = &tclParsedVarNameType;
 }
 
-static int
-CompareVarKeys(
-    void *keyPtr,		/* New key to compare. */
-    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
+static void
+UpdateParsedVarName(objPtr)
+    Tcl_Obj *objPtr;
 {
-    Tcl_Obj *objPtr1 = 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.
-     */
+    Tcl_Obj *arrayPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr1;
+    char *part2 = (char *) objPtr->internalRep.twoPtrValue.ptr2;
+    char *part1, *p;
+    int len1, len2, totalLen;
 
-    if (objPtr1 == objPtr2) {
-	return 1;
+    if (arrayPtr == NULL) {
+	/*
+	 * This is a parsed scalar name: what is it
+	 * doing here?
+	 */
+	panic("ERROR: scalar parsedVarName without a string rep.\n");
     }
+    part1 = Tcl_GetStringFromObj(arrayPtr, &len1);
+    len2 = strlen(part2);
+	
+    totalLen = len1 + len2 + 2;
+    p = ckalloc((unsigned int) totalLen + 1);
+    objPtr->bytes = p;
+    objPtr->length = totalLen;
 
-    /*
-     * 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 string representations of the same length.
-     */
-
-    return ((l1 == l2) && !memcmp(p1, p2, l1));
+    memcpy(p, part1, (unsigned int) len1);
+    p += len1;
+    *p++ = '(';
+    memcpy(p, part2, (unsigned int) len2);
+    p += len2;
+    *p++ = ')';
+    *p   = '\0';
 }
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
deleted file mode 100644
index 3673833..0000000
--- a/generic/tclZlib.c
+++ /dev/null
@@ -1,2982 +0,0 @@
-/*
- * tclZlib.c --
- *
- *	This file provides the interface to the Zlib library.
- *
- * Copyright (C) 2004-2005 Pascal Scheffers <pascal@scheffers.net>
- * Copyright (C) 2005 Unitas Software B.V.
- * Copyright (c) 2008-2009 Donal K. Fellows
- *
- * Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the
- * public domain March 2003.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-#ifdef HAVE_ZLIB
-#include <zlib.h>
-
-/*
- * Magic flags used with wbits fields to indicate that we're handling the gzip
- * format or automatic detection of format. Putting it here is slightly less
- * gross!
- */
-
-#define WBITS_RAW		(-MAX_WBITS)
-#define WBITS_ZLIB		(MAX_WBITS)
-#define WBITS_GZIP		(MAX_WBITS | 16)
-#define WBITS_AUTODETECT	(MAX_WBITS | 32)
-
-/*
- * Structure used for handling gzip headers that are generated from a
- * dictionary. It comprises the header structure itself plus some working
- * space that it is very convenient to have attached.
- */
-
-#define MAX_COMMENT_LEN		256
-
-typedef struct {
-    gz_header header;
-    char nativeFilenameBuf[MAXPATHLEN];
-    char nativeCommentBuf[MAX_COMMENT_LEN];
-} GzipHeader;
-
-/*
- * Structure used for the Tcl_ZlibStream* commands and [zlib stream ...]
- */
-
-typedef struct {
-    Tcl_Interp *interp;
-    z_stream stream;		/* The interface to the zlib library. */
-    int streamEnd;		/* If we've got to end-of-stream. */
-    Tcl_Obj *inData, *outData;	/* Input / output buffers (lists) */
-    Tcl_Obj *currentInput;	/* Pointer to what is currently being
-				 * inflated. */
-    int outPos;
-    int mode;			/* Either TCL_ZLIB_STREAM_DEFLATE or
-				 * TCL_ZLIB_STREAM_INFLATE. */
-    int format;			/* Flags from the TCL_ZLIB_FORMAT_* */
-    int level;			/* Default 5, 0-9 */
-    int flush;			/* Stores the flush param for deferred the
-				 * decompression. */
-    int wbits;			/* The encoded compression mode, so we can
-				 * restart the stream if necessary. */
-    Tcl_Command cmd;		/* Token for the associated Tcl command. */
-} ZlibStreamHandle;
-
-/*
- * Structure used for stacked channel compression and decompression.
- */
-
-typedef struct {
-    Tcl_Channel chan;		/* Reference to the channel itself. */
-    Tcl_Channel parent;		/* The underlying source and sink of bytes. */
-    int flags;			/* General flag bits, see below... */
-    int mode;			/* Either the value TCL_ZLIB_STREAM_DEFLATE
-				 * for compression on output, or
-				 * TCL_ZLIB_STREAM_INFLATE for decompression
-				 * on input. */
-    z_stream inStream;		/* Structure used by zlib for decompression of
-				 * input. */
-    z_stream outStream;		/* Structure used by zlib for compression of
-				 * output. */
-    char *inBuffer, *outBuffer;	/* Working buffers. */
-    int inAllocated, outAllocated;
-				/* Sizes of working buffers. */
-    GzipHeader inHeader;	/* Header read from input stream, when
-				 * decompressing a gzip stream. */
-    GzipHeader outHeader;	/* Header to write to an output stream, when
-				 * compressing a gzip stream. */
-    Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
-} ZlibChannelData;
-
-/*
- * Value bits for the flags field. Definitions are:
- *	ASYNC -		Whether this is an asynchronous channel.
- *	IN_HEADER -	Whether the inHeader field has been registered with
- *			the input compressor.
- *	OUT_HEADER -	Whether the outputHeader field has been registered
- *			with the output decompressor.
- */
-
-#define ASYNC			0x1
-#define IN_HEADER		0x2
-#define OUT_HEADER		0x4
-
-/*
- * Size of buffers allocated by default. Should be enough...
- */
-
-#define DEFAULT_BUFFER_SIZE	4096
-
-/*
- * Time to wait (in milliseconds) before flushing the channel when reading
- * data through the transform.
- */
-
-#define TRANSFORM_FLUSH_DELAY	5
-
-/*
- * Prototypes for private procedures defined later in this file:
- */
-
-static Tcl_CmdDeleteProc	ZlibStreamCmdDelete;
-static Tcl_DriverBlockModeProc	ZlibTransformBlockMode;
-static Tcl_DriverCloseProc	ZlibTransformClose;
-static Tcl_DriverGetHandleProc	ZlibTransformGetHandle;
-static Tcl_DriverGetOptionProc	ZlibTransformGetOption;
-static Tcl_DriverHandlerProc	ZlibTransformHandler;
-static Tcl_DriverInputProc	ZlibTransformInput;
-static Tcl_DriverOutputProc	ZlibTransformOutput;
-static Tcl_DriverSetOptionProc	ZlibTransformSetOption;
-static Tcl_DriverWatchProc	ZlibTransformWatch;
-static Tcl_ObjCmdProc		ZlibCmd;
-static Tcl_ObjCmdProc		ZlibStreamCmd;
-
-static void		ConvertError(Tcl_Interp *interp, int code);
-static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
-static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
-			    GzipHeader *headerPtr, int *extraSizePtr);
-static Tcl_Channel	ZlibStackChannelTransform(Tcl_Interp *interp,
-			    int mode, int format, int level,
-			    Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr);
-static void		ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
-static void		ZlibTransformTimerKill(ZlibChannelData *cd);
-static void		ZlibTransformTimerRun(ClientData clientData);
-static void		ZlibTransformTimerSetup(ZlibChannelData *cd);
-
-/*
- * Type of zlib-based compressing and decompressing channels.
- */
-
-static const Tcl_ChannelType zlibChannelType = {
-    "zlib",
-    TCL_CHANNEL_VERSION_3,
-    ZlibTransformClose,
-    ZlibTransformInput,
-    ZlibTransformOutput,
-    NULL,			/* seekProc */
-    ZlibTransformSetOption,
-    ZlibTransformGetOption,
-    ZlibTransformWatch,
-    ZlibTransformGetHandle,
-    NULL,			/* close2Proc */
-    ZlibTransformBlockMode,
-    NULL,			/* flushProc */
-    ZlibTransformHandler,
-    NULL,			/* wideSeekProc */
-    NULL,
-    NULL
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * ConvertError --
- *
- *	Utility function for converting a zlib error into a Tcl error.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Updates the interpreter result and errorcode.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ConvertError(
-    Tcl_Interp *interp,		/* Interpreter to store the error in. May be
-				 * NULL, in which case nothing happens. */
-    int code)			/* The zlib error code. */
-{
-    if (interp == NULL) {
-	return;
-    }
-
-    if (code == Z_ERRNO) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1));
-    } else {
-	const char *codeStr, *codeStr2 = NULL;
-	char codeStrBuf[TCL_INTEGER_SPACE];
-
-	switch (code) {
-	case Z_STREAM_ERROR:	codeStr = "STREAM";	break;
-	case Z_DATA_ERROR:	codeStr = "DATA";	break;
-	case Z_MEM_ERROR:	codeStr = "MEM";	break;
-	case Z_BUF_ERROR:	codeStr = "BUF";	break;
-	case Z_VERSION_ERROR:	codeStr = "VERSION";	break;
-	default:
-	    codeStr = "unknown";
-	    codeStr2 = codeStrBuf;
-	    sprintf(codeStrBuf, "%d", code);
-	    break;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
-
-	/*
-	 * Tricky point! We might pass NULL twice here (and will when the
-	 * error type is known).
-	 */
-
-	Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * GenerateHeader --
- *
- *	Function for creating a gzip header from the contents of a dictionary
- *	(as described in the documentation). GetValue is a helper function.
- *
- * Results:
- *	A Tcl result code.
- *
- * Side effects:
- *	Updates the fields of the given gz_header structure. Adds amount of
- *	extra space required for the header to the variable referenced by the
- *	extraSizePtr argument.
- *
- *----------------------------------------------------------------------
- */
-
-static inline int
-GetValue(
-    Tcl_Interp *interp,
-    Tcl_Obj *dictObj,
-    const char *nameStr,
-    Tcl_Obj **valuePtrPtr)
-{
-    Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1);
-    int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr);
-
-    TclDecrRefCount(name);
-    return result;
-}
-
-static int
-GenerateHeader(
-    Tcl_Interp *interp,		/* Where to put error messages. */
-    Tcl_Obj *dictObj,		/* The dictionary whose contents are to be
-				 * parsed. */
-    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
-    int *extraSizePtr)		/* Variable to add the length of header
-				 * strings (filename, comment) to. */
-{
-    Tcl_Obj *value;
-    int len, result = TCL_ERROR;
-    const char *valueStr;
-    Tcl_Encoding latin1enc;
-    static const char *const types[] = {
-	"binary", "text"
-    };
-
-    /*
-     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
-     */
-
-    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
-    if (latin1enc == NULL) {
-	Tcl_Panic("no latin-1 encoding");
-    }
-
-    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
-	goto error;
-    } else if (value != NULL) {
-	valueStr = Tcl_GetStringFromObj(value, &len);
-	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
-		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
-		NULL);
-	headerPtr->nativeCommentBuf[len] = '\0';
-	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
-	*extraSizePtr += len;
-    }
-
-    if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
-	goto error;
-    } else if (value != NULL &&
-	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
-	goto error;
-    }
-
-    if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
-	goto error;
-    } else if (value != NULL) {
-	valueStr = Tcl_GetStringFromObj(value, &len);
-	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
-		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
-	headerPtr->nativeFilenameBuf[len] = '\0';
-	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
-	*extraSizePtr += len;
-    }
-
-    if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
-	goto error;
-    } else if (value != NULL && Tcl_GetIntFromObj(interp, value,
-	    &headerPtr->header.os) != TCL_OK) {
-	goto error;
-    }
-
-    /*
-     * Ignore the 'size' field, since that is controlled by the size of the
-     * input data.
-     */
-
-    if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
-	goto error;
-    } else if (value != NULL && Tcl_GetLongFromObj(interp, value,
-	    (long *) &headerPtr->header.time) != TCL_OK) {
-	goto error;
-    }
-
-    if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
-	goto error;
-    } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
-	    "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
-	goto error;
-    }
-
-    result = TCL_OK;
-  error:
-    Tcl_FreeEncoding(latin1enc);
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ExtractHeader --
- *
- *	Take the values out of a gzip header and store them in a dictionary.
- *	SetValue is a helper function.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Updates the dictionary, which must be writable (i.e. refCount < 2).
- *
- *----------------------------------------------------------------------
- */
-
-static inline void
-SetValue(
-    Tcl_Obj *dictObj,
-    const char *key,
-    Tcl_Obj *value)
-{
-    Tcl_Obj *keyObj = Tcl_NewStringObj(key, -1);
-
-    Tcl_IncrRefCount(keyObj);
-    Tcl_DictObjPut(NULL, dictObj, keyObj, value);
-    TclDecrRefCount(keyObj);
-}
-
-static void
-ExtractHeader(
-    gz_header *headerPtr,	/* The gzip header to extract from. */
-    Tcl_Obj *dictObj)		/* The dictionary to store in. */
-{
-    Tcl_Encoding latin1enc = NULL;
-    Tcl_DString tmp;
-
-    if (headerPtr->comment != Z_NULL) {
-	if (latin1enc == NULL) {
-	    /*
-	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
-	     */
-
-	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
-	    if (latin1enc == NULL) {
-		Tcl_Panic("no latin-1 encoding");
-	    }
-	}
-
-	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
-		&tmp);
-	SetValue(dictObj, "comment", TclDStringToObj(&tmp));
-    }
-    SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
-    if (headerPtr->name != Z_NULL) {
-	if (latin1enc == NULL) {
-	    /*
-	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
-	     */
-
-	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
-	    if (latin1enc == NULL) {
-		Tcl_Panic("no latin-1 encoding");
-	    }
-	}
-
-	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
-		&tmp);
-	SetValue(dictObj, "filename", TclDStringToObj(&tmp));
-    }
-    if (headerPtr->os != 255) {
-	SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
-    }
-    if (headerPtr->time != 0 /* magic - no time */) {
-	SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
-    }
-    if (headerPtr->text != Z_UNKNOWN) {
-	SetValue(dictObj, "type",
-		Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
-    }
-
-    if (latin1enc != NULL) {
-	Tcl_FreeEncoding(latin1enc);
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamInit --
- *
- *	This command initializes a (de)compression context/handle for
- *	(de)compressing data in chunks.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	The variable pointed to by zshandlePtr is initialised and memory
- *	allocated for internal state. Additionally, if interp is not null, a
- *	Tcl command is created and its name placed in the interp result obj.
- *
- * Note:
- *	At least one of interp and zshandlePtr should be non-NULL or the
- *	reference to the stream will be completely lost.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibStreamInit(
-    Tcl_Interp *interp,
-    int mode,			/* Either TCL_ZLIB_STREAM_INFLATE or
-				 * TCL_ZLIB_STREAM_DEFLATE. */
-    int format,			/* Flags from the TCL_ZLIB_FORMAT_* set. */
-    int level,			/* 0-9 or TCL_ZLIB_COMPRESS_DEFAULT. */
-    Tcl_Obj *dictObj,		/* Dictionary containing headers for gzip. */
-    Tcl_ZlibStream *zshandlePtr)
-{
-    int wbits = 0;
-    int e;
-    ZlibStreamHandle *zshPtr = NULL;
-    Tcl_DString cmdname;
-    Tcl_CmdInfo cmdinfo;
-
-    switch (mode) {
-    case TCL_ZLIB_STREAM_DEFLATE:
-	/*
-	 * Compressed format is specified by the wbits parameter. See zlib.h
-	 * for details.
-	 */
-
-	switch (format) {
-	case TCL_ZLIB_FORMAT_RAW:
-	    wbits = WBITS_RAW;
-	    break;
-	case TCL_ZLIB_FORMAT_GZIP:
-	    wbits = WBITS_GZIP;
-	    break;
-	case TCL_ZLIB_FORMAT_ZLIB:
-	    wbits = WBITS_ZLIB;
-	    break;
-	default:
-	    Tcl_Panic("incorrect zlib data format, must be "
-		    "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP or "
-		    "TCL_ZLIB_FORMAT_RAW");
-	}
-	if (level < -1 || level > 9) {
-	    Tcl_Panic("compression level should be between 0 (no compression)"
-		    " and 9 (best compression) or -1 for default compression "
-		    "level");
-	}
-	break;
-    case TCL_ZLIB_STREAM_INFLATE:
-	/*
-	 * wbits are the same as DEFLATE, but FORMAT_AUTO is valid too.
-	 */
-
-	switch (format) {
-	case TCL_ZLIB_FORMAT_RAW:
-	    wbits = WBITS_RAW;
-	    break;
-	case TCL_ZLIB_FORMAT_GZIP:
-	    wbits = WBITS_GZIP;
-	    break;
-	case TCL_ZLIB_FORMAT_ZLIB:
-	    wbits = WBITS_ZLIB;
-	    break;
-	case TCL_ZLIB_FORMAT_AUTO:
-	    wbits = WBITS_AUTODETECT;
-	    break;
-	default:
-	    Tcl_Panic("incorrect zlib data format, must be "
-		    "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP, "
-		    "TCL_ZLIB_FORMAT_RAW or TCL_ZLIB_FORMAT_AUTO");
-	}
-	break;
-    default:
-	Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or"
-		" TCL_ZLIB_STREAM_INFLATE");
-    }
-
-    zshPtr = ckalloc(sizeof(ZlibStreamHandle));
-    zshPtr->interp = interp;
-    zshPtr->mode = mode;
-    zshPtr->format = format;
-    zshPtr->level = level;
-    zshPtr->wbits = wbits;
-    zshPtr->currentInput = NULL;
-    zshPtr->streamEnd = 0;
-    memset(&zshPtr->stream, 0, sizeof(z_stream));
-
-    /*
-     * No output buffer available yet
-     */
-
-    if (mode == TCL_ZLIB_STREAM_DEFLATE) {
-	e = deflateInit2(&zshPtr->stream, level, Z_DEFLATED, wbits,
-		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
-    } else {
-	e = inflateInit2(&zshPtr->stream, wbits);
-    }
-
-    if (e != Z_OK) {
-	ConvertError(interp, e);
-	goto error;
-    }
-
-    /*
-     * I could do all this in C, but this is easier.
-     */
-
-    if (interp != NULL) {
-	if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) {
-	    goto error;
-	}
-	Tcl_DStringInit(&cmdname);
-	Tcl_DStringAppend(&cmdname, "::tcl::zlib::streamcmd_", -1);
-	Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)),
-		-1);
-	if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
-		&cmdinfo) == 1) {
-	    Tcl_SetResult(interp,
-		    "BUG: Stream command name already exists", TCL_STATIC);
-	    Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL);
-	    Tcl_DStringFree(&cmdname);
-	    goto error;
-	}
-	Tcl_ResetResult(interp);
-
-	/*
-	 * Create the command.
-	 */
-
-	zshPtr->cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdname),
-		ZlibStreamCmd, zshPtr, ZlibStreamCmdDelete);
-	Tcl_DStringFree(&cmdname);
-	if (zshPtr->cmd == NULL) {
-	    goto error;
-	}
-    } else {
-	zshPtr->cmd = NULL;
-    }
-
-    /*
-     * Prepare the buffers for use.
-     */
-
-    zshPtr->inData = Tcl_NewListObj(0, NULL);
-    Tcl_IncrRefCount(zshPtr->inData);
-    zshPtr->outData = Tcl_NewListObj(0, NULL);
-    Tcl_IncrRefCount(zshPtr->outData);
-
-    zshPtr->outPos = 0;
-
-    /*
-     * Now set the variable pointed to by *zshandlePtr to the pointer to the
-     * zsh struct.
-     */
-
-    if (zshandlePtr) {
-	*zshandlePtr = (Tcl_ZlibStream) zshPtr;
-    }
-
-    return TCL_OK;
- error:
-    ckfree(zshPtr);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ZlibStreamCmdDelete --
- *
- *	This is the delete command which Tcl invokes when a zlibstream command
- *	is deleted from the interpreter (on stream close, usually).
- *
- * Results:
- *	None
- *
- * Side effects:
- *	Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
- *
- *----------------------------------------------------------------------
- */
-
-static void
-ZlibStreamCmdDelete(
-    ClientData cd)
-{
-    ZlibStreamHandle *zshPtr = cd;
-
-    zshPtr->cmd = NULL;
-    ZlibStreamCleanup(zshPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamClose --
- *
- *	This procedure must be called after (de)compression is done to ensure
- *	memory is freed and the command is deleted from the interpreter (if
- *	any).
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibStreamClose(
-    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit. */
-{
-    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
-
-    /*
-     * If the interp is set, deleting the command will trigger
-     * ZlibStreamCleanup in ZlibStreamCmdDelete. If no interp is set, call
-     * ZlibStreamCleanup directly.
-     */
-
-    if (zshPtr->interp && zshPtr->cmd) {
-	Tcl_DeleteCommandFromToken(zshPtr->interp, zshPtr->cmd);
-    } else {
-	ZlibStreamCleanup(zshPtr);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ZlibStreamCleanup --
- *
- *	This procedure is called by either Tcl_ZlibStreamClose or
- *	ZlibStreamCmdDelete to cleanup the stream context.
- *
- * Results:
- *	None
- *
- * Side effects:
- *	Invalidates the zlib stream handle.
- *
- *----------------------------------------------------------------------
- */
-
-void
-ZlibStreamCleanup(
-    ZlibStreamHandle *zshPtr)
-{
-    if (!zshPtr->streamEnd) {
-	if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
-	    deflateEnd(&zshPtr->stream);
-	} else {
-	    inflateEnd(&zshPtr->stream);
-	}
-    }
-
-    if (zshPtr->inData) {
-	Tcl_DecrRefCount(zshPtr->inData);
-    }
-    if (zshPtr->outData) {
-	Tcl_DecrRefCount(zshPtr->outData);
-    }
-    if (zshPtr->currentInput) {
-	Tcl_DecrRefCount(zshPtr->currentInput);
-    }
-
-    ckfree(zshPtr);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamReset --
- *
- *	This procedure will reinitialize an existing stream handle.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Any data left in the (de)compression buffer is lost.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibStreamReset(
-    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
-{
-    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
-    int e;
-
-    if (!zshPtr->streamEnd) {
-	if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
-	    deflateEnd(&zshPtr->stream);
-	} else {
-	    inflateEnd(&zshPtr->stream);
-	}
-    }
-    Tcl_SetByteArrayLength(zshPtr->inData, 0);
-    Tcl_SetByteArrayLength(zshPtr->outData, 0);
-    if (zshPtr->currentInput) {
-	Tcl_DecrRefCount(zshPtr->currentInput);
-	zshPtr->currentInput = NULL;
-    }
-
-    zshPtr->outPos = 0;
-    zshPtr->streamEnd = 0;
-    memset(&zshPtr->stream, 0, sizeof(z_stream));
-
-    /*
-     * No output buffer available yet.
-     */
-
-    if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
-	e = deflateInit2(&zshPtr->stream, zshPtr->level, Z_DEFLATED,
-		zshPtr->wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
-    } else {
-	e = inflateInit2(&zshPtr->stream, zshPtr->wbits);
-    }
-
-    if (e != Z_OK) {
-	ConvertError(zshPtr->interp, e);
-	/* TODO:cleanup */
-	return TCL_ERROR;
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamGetCommandName --
- *
- *	This procedure will return the command name associated with the
- *	stream.
- *
- * Results:
- *	A Tcl_Obj with the name of the Tcl command or NULL if no command is
- *	associated with the stream.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Obj *
-Tcl_ZlibStreamGetCommandName(
-    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
-{
-    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
-    Tcl_Obj *objPtr;
-
-    if (!zshPtr->interp) {
-	return NULL;
-    }
-
-    TclNewObj(objPtr);
-    Tcl_GetCommandFullName(zshPtr->interp, zshPtr->cmd, objPtr);
-    return objPtr;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamEof --
- *
- *	This procedure This function returns 0 or 1 depending on the state of
- *	the (de)compressor. For decompression, eof is reached when the entire
- *	compressed stream has been decompressed. For compression, eof is
- *	reached when the stream has been flushed with TCL_ZLIB_FINALIZE.
- *
- * Results:
- *	Integer.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibStreamEof(
-    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
-{
-    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
-
-    return zshPtr->streamEnd;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamChecksum --
- *
- *	Return the checksum of the uncompressed data seen so far by the
- *	stream.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibStreamChecksum(
-    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
-{
-    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
-
-    return zshPtr->stream.adler;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamPut --
- *
- *	Add data to the stream for compression or decompression from a
- *	bytearray Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibStreamPut(
-    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
-    Tcl_Obj *data,		/* Data to compress/decompress */
-    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
-				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
-{
-    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
-    char *dataTmp = NULL;
-    int e, size, outSize;
-    Tcl_Obj *obj;
-
-    if (zshPtr->streamEnd) {
-	if (zshPtr->interp) {
-	    Tcl_SetResult(zshPtr->interp,
-		    "already past compressed stream end", TCL_STATIC);
-	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
-	zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size);
-	zshPtr->stream.avail_in = size;
-
-	/*
-	 * Deflatebound doesn't seem to take various header sizes into
-	 * account, so we add 100 extra bytes.
-	 */
-
-	outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
-	zshPtr->stream.avail_out = outSize;
-	dataTmp = ckalloc(zshPtr->stream.avail_out);
-	zshPtr->stream.next_out = (Bytef *) dataTmp;
-
-	e = deflate(&zshPtr->stream, flush);
-	if ((e==Z_OK || e==Z_BUF_ERROR) && (zshPtr->stream.avail_out == 0)) {
-	    if (outSize - zshPtr->stream.avail_out > 0) {
-		/*
-		 * Output buffer too small.
-		 */
-
-		obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
-			outSize - zshPtr->stream.avail_out);
-
-		/*
-		 * Now append the compressed data to the outData list.
-		 */
-
-		Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
-	    }
-	    if (outSize < 0xFFFF) {
-		outSize = 0xFFFF;	/* There may be *lots* of data left to
-					 * output... */
-		ckfree(dataTmp);
-		dataTmp = ckalloc(outSize);
-	    }
-	    zshPtr->stream.avail_out = outSize;
-	    zshPtr->stream.next_out = (Bytef *) dataTmp;
-
-	    e = deflate(&zshPtr->stream, flush);
-	}
-
-	/*
-	 * And append the final data block.
-	 */
-
-	if (outSize - zshPtr->stream.avail_out > 0) {
-	    obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
-		    outSize - zshPtr->stream.avail_out);
-
-	    /*
-	     * Now append the compressed data to the outData list.
-	     */
-
-	    Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
-	}
-
-	if (dataTmp) {
-	    ckfree(dataTmp);
-	}
-    } else {
-	/*
-	 * This is easy. Just append to the inData list.
-	 */
-
-	Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);
-
-	/*
-	 * and we'll need the flush parameter for the Inflate call.
-	 */
-
-	zshPtr->flush = flush;
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibStreamGet --
- *
- *	Retrieve data (now compressed or decompressed) from the stream into a
- *	bytearray Tcl_Obj.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibStreamGet(
-    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
-    Tcl_Obj *data,		/* A place to append the data. */
-    int count)			/* Number of bytes to grab as a maximum, you
-				 * may get less! */
-{
-    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
-    int e, i, listLen, itemLen, dataPos = 0;
-    Tcl_Obj *itemObj;
-    unsigned char *dataPtr, *itemPtr;
-    int existing;
-
-    /*
-     * Getting beyond the of stream, just return empty string.
-     */
-
-    if (zshPtr->streamEnd) {
-	return TCL_OK;
-    }
-
-    (void) Tcl_GetByteArrayFromObj(data, &existing);
-
-    if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
-	if (count == -1) {
-	    /*
-	     * The only safe thing to do is restict to 65k. We might cause a
-	     * panic for out of memory if we just kept growing the buffer.
-	     */
-
-	    count = 65536;
-	}
-
-	/*
-	 * Prepare the place to store the data.
-	 */
-
-	dataPtr = Tcl_SetByteArrayLength(data, existing+count);
-	dataPtr += existing;
-
-	zshPtr->stream.next_out = dataPtr;
-	zshPtr->stream.avail_out = count;
-	if (zshPtr->stream.avail_in == 0) {
-	    /*
-	     * zlib will probably need more data to decompress.
-	     */
-
-	    if (zshPtr->currentInput) {
-		Tcl_DecrRefCount(zshPtr->currentInput);
-		zshPtr->currentInput = NULL;
-	    }
-	    Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
-	    if (listLen > 0) {
-		/*
-		 * There is more input available, get it from the list and
-		 * give it to zlib. At this point, the data must not be shared
-		 * since we require the bytearray representation to not vanish
-		 * under our feet. [Bug 3081008]
-		 */
-
-		Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj);
-		if (Tcl_IsShared(itemObj)) {
-		    itemObj = Tcl_DuplicateObj(itemObj);
-		}
-		itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
-		Tcl_IncrRefCount(itemObj);
-		zshPtr->currentInput = itemObj;
-		zshPtr->stream.next_in = itemPtr;
-		zshPtr->stream.avail_in = itemLen;
-
-		/*
-		 * And remove it from the list
-		 */
-
-		Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
-	    }
-	}
-
-	e = inflate(&zshPtr->stream, zshPtr->flush);
-	Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
-
-	while ((zshPtr->stream.avail_out > 0)
-		&& (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) {
-	    /*
-	     * State: We have not satisfied the request yet and there may be
-	     * more to inflate.
-	     */
-
-	    if (zshPtr->stream.avail_in > 0) {
-		if (zshPtr->interp) {
-		    Tcl_SetResult(zshPtr->interp,
-			"Unexpected zlib internal state during decompression",
-			TCL_STATIC);
-		    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE",
-			    NULL);
-		}
-		Tcl_SetByteArrayLength(data, existing);
-		return TCL_ERROR;
-	    }
-
-	    if (zshPtr->currentInput) {
-		Tcl_DecrRefCount(zshPtr->currentInput);
-		zshPtr->currentInput = 0;
-	    }
-
-	    /*
-	     * Get the next block of data to go to inflate. At this point, the
-	     * data must not be shared since we require the bytearray
-	     * representation to not vanish under our feet. [Bug 3081008]
-	     */
-
-	    Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj);
-	    if (Tcl_IsShared(itemObj)) {
-		itemObj = Tcl_DuplicateObj(itemObj);
-	    }
-	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
-	    Tcl_IncrRefCount(itemObj);
-	    zshPtr->currentInput = itemObj;
-	    zshPtr->stream.next_in = itemPtr;
-	    zshPtr->stream.avail_in = itemLen;
-
-	    /*
-	     * Remove it from the list.
-	     */
-
-	    Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
-	    listLen--;
-
-	    /*
-	     * And call inflate again.
-	     */
-
-	    e = inflate(&zshPtr->stream, zshPtr->flush);
-	}
-	if (zshPtr->stream.avail_out > 0) {
-	    Tcl_SetByteArrayLength(data,
-		    existing + count - zshPtr->stream.avail_out);
-	}
-	if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) {
-	    Tcl_SetByteArrayLength(data, existing);
-	    ConvertError(zshPtr->interp, e);
-	    return TCL_ERROR;
-	}
-	if (e == Z_STREAM_END) {
-	    zshPtr->streamEnd = 1;
-	    if (zshPtr->currentInput) {
-		Tcl_DecrRefCount(zshPtr->currentInput);
-		zshPtr->currentInput = 0;
-	    }
-	    inflateEnd(&zshPtr->stream);
-	}
-    } else {
-	Tcl_ListObjLength(NULL, zshPtr->outData, &listLen);
-	if (count == -1) {
-	    count = 0;
-	    for (i=0; i<listLen; i++) {
-		Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
-		itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
-		if (i == 0) {
-		    count += itemLen - zshPtr->outPos;
-		} else {
-		    count += itemLen;
-		}
-	    }
-	}
-
-	/*
-	 * Prepare the place to store the data.
-	 */
-
-	dataPtr = Tcl_SetByteArrayLength(data, existing + count);
-	dataPtr += existing;
-
-	while ((count > dataPos) &&
-		(Tcl_ListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK)
-		&& (listLen > 0)) {
-	    /*
-	     * Get the next chunk off our list of chunks and grab the data out
-	     * of it.
-	     */
-
-	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
-	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
-	    if (itemLen-zshPtr->outPos >= count-dataPos) {
-		unsigned len = count - dataPos;
-
-		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
-		zshPtr->outPos += len;
-		dataPos += len;
-		if (zshPtr->outPos == itemLen) {
-		    zshPtr->outPos = 0;
-		}
-	    } else {
-		unsigned len = itemLen - zshPtr->outPos;
-
-		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
-		dataPos += len;
-		zshPtr->outPos = 0;
-	    }
-	    if (zshPtr->outPos == 0) {
-		Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);
-		listLen--;
-	    }
-	}
-	Tcl_SetByteArrayLength(data, existing + dataPos);
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibDeflate --
- *
- *	Compress the contents of Tcl_Obj *data with compression level in
- *	output format, producing the compressed data in the interpreter
- *	result.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibDeflate(
-    Tcl_Interp *interp,
-    int format,
-    Tcl_Obj *data,
-    int level,
-    Tcl_Obj *gzipHeaderDictObj)
-{
-    int wbits = 0, inLen = 0, e = 0, extraSize = 0;
-    Byte *inData = NULL;
-    z_stream stream;
-    GzipHeader header;
-    gz_header *headerPtr = NULL;
-    Tcl_Obj *obj;
-
-    if (!interp) {
-	return TCL_ERROR;
-    }
- 
-    /*
-     * Compressed format is specified by the wbits parameter. See zlib.h for
-     * details.
-     */
-
-    if (format == TCL_ZLIB_FORMAT_RAW) {
-	wbits = WBITS_RAW;
-    } else if (format == TCL_ZLIB_FORMAT_GZIP) {
-	wbits = WBITS_GZIP;
-
-	/*
-	 * Need to allocate extra space for the gzip header and footer. The
-	 * amount of space is (a bit less than) 32 bytes, plus a byte for each
-	 * byte of string that we add. Note that over-allocation is not a
-	 * problem. [Bug 2419061]
-	 */
-
-	extraSize = 32;
-	if (gzipHeaderDictObj) {
-	    headerPtr = &header.header;
-	    memset(headerPtr, 0, sizeof(gz_header));
-	    if (GenerateHeader(interp, gzipHeaderDictObj, &header,
-		    &extraSize) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	}
-    } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
-	wbits = WBITS_ZLIB;
-    } else {
-	Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
-		"TCL_ZLIB_FORMAT_GZIP or TCL_ZLIB_FORMAT_ZLIB");
-    }
-
-    if (level < -1 || level > 9) {
-	Tcl_Panic("compression level should be between 0 (uncompressed) and "
-		"9 (best compression) or -1 for default compression level");
-    }
-
-    /*
-     * Allocate some space to store the output.
-     */
-
-    TclNewObj(obj);
-
-    /*
-     * Obtain the pointer to the byte array, we'll pass this pointer straight
-     * to the deflate command.
-     */
-
-    inData = Tcl_GetByteArrayFromObj(data, &inLen);
-    memset(&stream, 0, sizeof(z_stream));
-    stream.avail_in = (uInt) inLen;
-    stream.next_in = inData;
-
-    /*
-     * No output buffer available yet, will alloc after deflateInit2.
-     */
-
-    e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL,
-	    Z_DEFAULT_STRATEGY);
-    if (e != Z_OK) {
-	goto error;
-    }
-
-    if (headerPtr != NULL) {
-	e = deflateSetHeader(&stream, headerPtr);
-	if (e != Z_OK) {
-	    goto error;
-	}
-    }
-
-    /*
-     * Allocate the output buffer from the value of deflateBound(). This is
-     * probably too much space. Before returning to the caller, we will reduce
-     * it back to the actual compressed size.
-     */
-
-    stream.avail_out = deflateBound(&stream, inLen) + extraSize;
-    stream.next_out = Tcl_SetByteArrayLength(obj, stream.avail_out);
-
-    /*
-     * Perform the compression, Z_FINISH means do it in one go.
-     */
-
-    e = deflate(&stream, Z_FINISH);
-
-    if (e != Z_STREAM_END) {
-	e = deflateEnd(&stream);
-
-	/*
-	 * deflateEnd() returns Z_OK when there are bytes left to compress, at
-	 * this point we consider that an error, although we could continue by
-	 * allocating more memory and calling deflate() again.
-	 */
-
-	if (e == Z_OK) {
-	    e = Z_BUF_ERROR;
-	}
-    } else {
-	e = deflateEnd(&stream);
-    }
-
-    if (e != Z_OK) {
-	goto error;
-    }
-
-    /*
-     * Reduce the bytearray length to the actual data length produced by
-     * deflate.
-     */
-
-    Tcl_SetByteArrayLength(obj, stream.total_out);
-    Tcl_SetObjResult(interp, obj);
-    return TCL_OK;
-
-  error:
-    ConvertError(interp, e);
-    TclDecrRefCount(obj);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibInflate --
- *
- *	Decompress data in an object into the interpreter result.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_ZlibInflate(
-    Tcl_Interp *interp,
-    int format,
-    Tcl_Obj *data,
-    int bufferSize,
-    Tcl_Obj *gzipHeaderDictObj)
-{
-    int wbits = 0, inLen = 0, e = 0, newBufferSize;
-    Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
-    z_stream stream;
-    gz_header header, *headerPtr = NULL;
-    Tcl_Obj *obj;
-    char *nameBuf = NULL, *commentBuf = NULL;
-
-    if (!interp) {
-	return TCL_ERROR;
-    }
-
-    /*
-     * Compressed format is specified by the wbits parameter. See zlib.h for
-     * details.
-     */
-
-    switch (format) {
-    case TCL_ZLIB_FORMAT_RAW:
-	wbits = WBITS_RAW;
-	gzipHeaderDictObj = NULL;
-	break;
-    case TCL_ZLIB_FORMAT_ZLIB:
-	wbits = WBITS_ZLIB;
-	gzipHeaderDictObj = NULL;
-	break;
-    case TCL_ZLIB_FORMAT_GZIP:
-	wbits = WBITS_GZIP;
-	break;
-    case TCL_ZLIB_FORMAT_AUTO:
-	wbits = WBITS_AUTODETECT;
-	break;
-    default:
-	Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
-		"TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or "
-		"TCL_ZLIB_FORMAT_AUTO");
-    }
-
-    if (gzipHeaderDictObj) {
-	headerPtr = &header;
-	memset(headerPtr, 0, sizeof(gz_header));
-	nameBuf = ckalloc(MAXPATHLEN);
-	header.name = (Bytef *) nameBuf;
-	header.name_max = MAXPATHLEN - 1;
-	commentBuf = ckalloc(MAX_COMMENT_LEN);
-	header.comment = (Bytef *) commentBuf;
-	header.comm_max = MAX_COMMENT_LEN - 1;
-    }
-
-    inData = Tcl_GetByteArrayFromObj(data, &inLen);
-    if (bufferSize < 1) {
-	/*
-	 * Start with a buffer (up to) 3 times the size of the input data.
-	 */
-
-	if (inLen < 32*1024*1024) {
-	    bufferSize = 3*inLen;
-	} else if (inLen < 256*1024*1024) {
-	    bufferSize = 2*inLen;
-	} else {
-	    bufferSize = inLen;
-	}
-    }
-
-    TclNewObj(obj);
-    outData = Tcl_SetByteArrayLength(obj, bufferSize);
-    memset(&stream, 0, sizeof(z_stream));
-    stream.avail_in = (uInt) inLen+1;	/* +1 because zlib can "over-request"
-					 * input (but ignore it!) */
-    stream.next_in = inData;
-    stream.avail_out = bufferSize;
-    stream.next_out = outData;
-
-    /*
-     * Initialize zlib for decompression.
-     */
-
-    e = inflateInit2(&stream, wbits);
-    if (e != Z_OK) {
-	goto error;
-    }
-    if (headerPtr) {
-	e = inflateGetHeader(&stream, headerPtr);
-	if (e != Z_OK) {
-	    goto error;
-	}
-    }
-
-    /*
-     * Start the decompression cycle.
-     */
-
-    while (1) {
-	e = inflate(&stream, Z_FINISH);
-	if (e != Z_BUF_ERROR) {
-	    break;
-	}
-
-	/*
-	 * Not enough room in the output buffer. Increase it by five times the
-	 * bytes still in the input buffer. (Because 3 times didn't do the
-	 * trick before, 5 times is what we do next.) Further optimization
-	 * should be done by the user, specify the decompressed size!
-	 */
-
-	if ((stream.avail_in == 0) && (stream.avail_out > 0)) {
-	    e = Z_STREAM_ERROR;
-	    goto error;
-	}
-	newBufferSize = bufferSize + 5 * stream.avail_in;
-	if (newBufferSize == bufferSize) {
-	    newBufferSize = bufferSize+1000;
-	}
-	newOutData = Tcl_SetByteArrayLength(obj, newBufferSize);
-
-	/*
-	 * Set next out to the same offset in the new location.
-	 */
-
-	stream.next_out = newOutData + stream.total_out;
-
-	/*
-	 * And increase avail_out with the number of new bytes allocated.
-	 */
-
-	stream.avail_out += newBufferSize - bufferSize;
-	outData = newOutData;
-	bufferSize = newBufferSize;
-    }
-
-    if (e != Z_STREAM_END) {
-	inflateEnd(&stream);
-	goto error;
-    }
-
-    e = inflateEnd(&stream);
-    if (e != Z_OK) {
-	goto error;
-    }
-
-    /*
-     * Reduce the BA length to the actual data length produced by deflate.
-     */
-
-    Tcl_SetByteArrayLength(obj, stream.total_out);
-    if (headerPtr != NULL) {
-	ExtractHeader(&header, gzipHeaderDictObj);
-	SetValue(gzipHeaderDictObj, "size",
-		Tcl_NewLongObj((long) stream.total_out));
-	ckfree(nameBuf);
-	ckfree(commentBuf);
-    }
-    Tcl_SetObjResult(interp, obj);
-    return TCL_OK;
-
-  error:
-    TclDecrRefCount(obj);
-    ConvertError(interp, e);
-    if (nameBuf) {
-	ckfree(nameBuf);
-    }
-    if (commentBuf) {
-	ckfree(commentBuf);
-    }
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_ZlibCRC32, Tcl_ZlibAdler32 --
- *
- *	Access to the checksumming engines.
- *
- *----------------------------------------------------------------------
- */
-
-unsigned int
-Tcl_ZlibCRC32(
-    unsigned int crc,
-    const unsigned char *buf,
-    int len)
-{
-    /* Nothing much to do, just wrap the crc32(). */
-    return crc32(crc, (Bytef *) buf, (unsigned) len);
-}
-
-unsigned int
-Tcl_ZlibAdler32(
-    unsigned int adler,
-    const unsigned char *buf,
-    int len)
-{
-    return adler32(adler, (Bytef *) buf, (unsigned) len);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ZlibCmd --
- *
- *	Implementation of the [zlib] command.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ZlibCmd(
-    ClientData notUsed,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    int command, dlen, mode, format, i, option, level = -1;
-    unsigned start, buffersize = 0;
-    Tcl_ZlibStream zh;
-    Byte *data;
-    Tcl_Obj *headerDictObj, *headerVarObj;
-    const char *extraInfoStr = NULL;
-    static const char *const commands[] = {
-	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
-	"gzip", "inflate", "push", "stream",
-	NULL
-    };
-    enum zlibCommands {
-	CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE,
-	CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM
-    };
-    static const char *const stream_formats[] = {
-	"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
-	NULL
-    };
-    enum zlibFormats {
-	FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
-	FMT_INFLATE
-    };
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0,
-	    &command) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum zlibCommands) command) {
-    case CMD_ADLER:			/* adler32 str ?startvalue?
-					 * -> checksum */
-	if (objc < 3 || objc > 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
-	    return TCL_ERROR;
-	}
-	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
-		(int *) &start) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (objc < 4) {
-	    start = Tcl_ZlibAdler32(0, NULL, 0);
-	}
-	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
-	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
-		Tcl_ZlibAdler32(start, data, dlen)));
-	return TCL_OK;
-    case CMD_CRC:			/* crc32 str ?startvalue?
-					 * -> checksum */
-	if (objc < 3 || objc > 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
-	    return TCL_ERROR;
-	}
-	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
-		(int *) &start) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	if (objc < 4) {
-	    start = Tcl_ZlibCRC32(0, NULL, 0);
-	}
-	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
-	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
-		Tcl_ZlibCRC32(start, data, dlen)));
-	return TCL_OK;
-    case CMD_DEFLATE:			/* deflate data ?level?
-					 * -> rawCompressedData */
-	if (objc < 3 || objc > 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
-	    return TCL_ERROR;
-	}
-	if (objc > 3) {
-	    if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (level < 0 || level > 9) {
-		goto badLevel;
-	    }
-	}
-	return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level,
-		NULL);
-    case CMD_COMPRESS:			/* compress data ?level?
-					 * -> zlibCompressedData */
-	if (objc < 3 || objc > 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
-	    return TCL_ERROR;
-	}
-	if (objc > 3) {
-	    if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (level < 0 || level > 9) {
-		goto badLevel;
-	    }
-	}
-	return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level,
-		NULL);
-    case CMD_GZIP:			/* gzip data ?level?
-					 * -> gzippedCompressedData */
-	if (objc < 3 || objc > 7 || ((objc & 1) == 0)) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "data ?-level level? ?-header header?");
-	    return TCL_ERROR;
-	}
-	headerDictObj = NULL;
-	for (i=3 ; i<objc ; i+=2) {
-	    static const char *const gzipopts[] = {
-		"-header", "-level", NULL
-	    };
-
-	    if (Tcl_GetIndexFromObj(interp, objv[i], gzipopts, "option", 0,
-		    &option) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    switch (option) {
-	    case 0:
-		headerDictObj = objv[i+1];
-		break;
-	    case 1:
-		if (Tcl_GetIntFromObj(interp, objv[i+1],
-			&level) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (level < 0 || level > 9) {
-		    extraInfoStr = "\n    (in -level option)";
-		    goto badLevel;
-		}
-		break;
-	    }
-	}
-	return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level,
-		headerDictObj);
-    case CMD_INFLATE:			/* inflate rawcomprdata ?bufferSize?
-					 *	-> decompressedData */
-	if (objc < 3 || objc > 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
-	    return TCL_ERROR;
-	}
-	if (objc > 3) {
-	    if (Tcl_GetIntFromObj(interp, objv[3],
-		    (int *) &buffersize) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (buffersize < 16 || buffersize > 65536) {
-		goto badBuffer;
-	    }
-	}
-	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2],
-		buffersize, NULL);
-    case CMD_DECOMPRESS:		/* decompress zlibcomprdata \
-					 *    ?bufferSize?
-					 *	-> decompressedData */
-	if (objc < 3 || objc > 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
-	    return TCL_ERROR;
-	}
-	if (objc > 3) {
-	    if (Tcl_GetIntFromObj(interp, objv[3],
-		    (int *) &buffersize) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (buffersize < 16 || buffersize > 65536) {
-		goto badBuffer;
-	    }
-	}
-	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
-		buffersize, NULL);
-    case CMD_GUNZIP:			/* gunzip gzippeddata ?bufferSize?
-					 *	-> decompressedData */
-	if (objc < 3 || objc > 5 || ((objc & 1) == 0)) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-headerVar varName?");
-	    return TCL_ERROR;
-	}
-	headerDictObj = headerVarObj = NULL;
-	for (i=3 ; i<objc ; i+=2) {
-	    static const char *const gunzipopts[] = {
-		"-buffersize", "-headerVar", NULL
-	    };
-
-	    if (Tcl_GetIndexFromObj(interp, objv[i], gunzipopts, "option", 0,
-		    &option) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    switch (option) {
-	    case 0:
-		if (Tcl_GetIntFromObj(interp, objv[i+1],
-			(int *) &buffersize) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (buffersize < 16 || buffersize > 65536) {
-		    goto badBuffer;
-		}
-		break;
-	    case 1:
-		headerVarObj = objv[i+1];
-		headerDictObj = Tcl_NewObj();
-		break;
-	    }
-	}
-	if (Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2],
-		buffersize, headerDictObj) != TCL_OK) {
-	    if (headerDictObj) {
-		TclDecrRefCount(headerDictObj);
-	    }
-	    return TCL_ERROR;
-	}
-	if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL,
-		headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) {
-	    if (headerDictObj) {
-		TclDecrRefCount(headerDictObj);
-	    }
-	    return TCL_ERROR;
-	}
-	return TCL_OK;
-    case CMD_STREAM:			/* stream deflate/inflate/...gunzip \
-					 *    ?level?
-					 *	-> handleCmd */
-	if (objc < 3 || objc > 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "mode ?level?");
-	    return TCL_ERROR;
-	}
-	if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
-		&format) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	mode = TCL_ZLIB_STREAM_INFLATE;
-	switch ((enum zlibFormats) format) {
-	case FMT_DEFLATE:
-	    mode = TCL_ZLIB_STREAM_DEFLATE;
-	case FMT_INFLATE:
-	    format = TCL_ZLIB_FORMAT_RAW;
-	    break;
-	case FMT_COMPRESS:
-	    mode = TCL_ZLIB_STREAM_DEFLATE;
-	case FMT_DECOMPRESS:
-	    format = TCL_ZLIB_FORMAT_ZLIB;
-	    break;
-	case FMT_GZIP:
-	    mode = TCL_ZLIB_STREAM_DEFLATE;
-	case FMT_GUNZIP:
-	    format = TCL_ZLIB_FORMAT_GZIP;
-	    break;
-	}
-	if (objc == 4) {
-	    if (Tcl_GetIntFromObj(interp, objv[3],
-		    (int *) &level) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (level < 0 || level > 9) {
-		goto badLevel;
-	    }
-	} else {
-	    level = Z_DEFAULT_COMPRESSION;
-	}
-	if (Tcl_ZlibStreamInit(interp, mode, format, level, NULL,
-		&zh) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
-	return TCL_OK;
-    case CMD_PUSH: {			/* push mode channel options...
-					 *	-> channel */
-	Tcl_Channel chan;
-	int chanMode;
-	static const char *const pushOptions[] = {
-	    "-header", "-level", "-limit",
-	    NULL
-	};
-	enum pushOptions {poHeader, poLevel, poLimit};
-	Tcl_Obj *headerObj = NULL;
-	int limit = 1, dummy;
-
-	if (objc < 4) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
-	    return TCL_ERROR;
-	}
-
-	if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
-		&format) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	switch ((enum zlibFormats) format) {
-	case FMT_DEFLATE:
-	    mode = TCL_ZLIB_STREAM_DEFLATE;
-	    format = TCL_ZLIB_FORMAT_RAW;
-	    break;
-	case FMT_INFLATE:
-	    mode = TCL_ZLIB_STREAM_INFLATE;
-	    format = TCL_ZLIB_FORMAT_RAW;
-	    break;
-	case FMT_COMPRESS:
-	    mode = TCL_ZLIB_STREAM_DEFLATE;
-	    format = TCL_ZLIB_FORMAT_ZLIB;
-	    break;
-	case FMT_DECOMPRESS:
-	    mode = TCL_ZLIB_STREAM_INFLATE;
-	    format = TCL_ZLIB_FORMAT_ZLIB;
-	    break;
-	case FMT_GZIP:
-	    mode = TCL_ZLIB_STREAM_DEFLATE;
-	    format = TCL_ZLIB_FORMAT_GZIP;
-	    break;
-	case FMT_GUNZIP:
-	    mode = TCL_ZLIB_STREAM_INFLATE;
-	    format = TCL_ZLIB_FORMAT_GZIP;
-	    break;
-	default:
-	    Tcl_AppendResult(interp, "IMPOSSIBLE", NULL);
-	    return TCL_ERROR;
-	}
-
-	if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode,
-		0) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Sanity checks.
-	 */
-
-	if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) {
-	    Tcl_AppendResult(interp,
-		    "compression may only be applied to writable channels",
-		    NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
-	    return TCL_ERROR;
-	}
-	if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
-	    Tcl_AppendResult(interp,
-		    "decompression may only be applied to readable channels",
-		    NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Parse options.
-	 */
-
-	level = Z_DEFAULT_COMPRESSION;
-	for (i=4 ; i<objc ; i++) {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0,
-		    &option) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    switch ((enum pushOptions) option) {
-	    case poHeader:
-		if (++i > objc-1) {
-		    Tcl_AppendResult(interp,
-			    "value missing for -header option", NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
-		    return TCL_ERROR;
-		}
-		headerObj = objv[i];
-		if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
-		    Tcl_AddErrorInfo(interp, "\n    (in -header option)");
-		    return TCL_ERROR;
-		}
-		break;
-	    case poLevel:
-		if (++i > objc-1) {
-		    Tcl_AppendResult(interp,
-			    "value missing for -level option", NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
-		    return TCL_ERROR;
-		}
-		if (Tcl_GetIntFromObj(interp, objv[i],
-			(int *) &level) != TCL_OK) {
-		    Tcl_AddErrorInfo(interp, "\n    (in -level option)");
-		    return TCL_ERROR;
-		}
-		if (level < 0 || level > 9) {
-		    extraInfoStr = "\n    (in -level option)";
-		    goto badLevel;
-		}
-		break;
-	    case poLimit:
-		if (++i > objc-1) {
-		    Tcl_AppendResult(interp,
-			    "value missing for -limit option", NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
-		    return TCL_ERROR;
-		}
-		if (Tcl_GetIntFromObj(interp, objv[i],
-			(int *) &limit) != TCL_OK) {
-		    Tcl_AddErrorInfo(interp, "\n    (in -limit option)");
-		    return TCL_ERROR;
-		}
-		if (limit < 1) {
-		    limit = 1;
-		}
-		break;
-	    }
-	}
-
-	if (ZlibStackChannelTransform(interp, mode, format, level, chan,
-		headerObj) == NULL) {
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, objv[3]);
-	return TCL_OK;
-    }
-    };
-
-    return TCL_ERROR;
-
-  badLevel:
-    Tcl_AppendResult(interp, "level must be 0 to 9", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
-    if (extraInfoStr) {
-	Tcl_AddErrorInfo(interp, extraInfoStr);
-    }
-    return TCL_ERROR;
-  badBuffer:
-    Tcl_AppendResult(interp, "buffer size must be 32 to 65536", NULL);
-    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ZlibStreamCmd --
- *
- *	Implementation of the commands returned by [zlib stream].
- *
- *----------------------------------------------------------------------
- */
-
-static int
-ZlibStreamCmd(
-    ClientData cd,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    Tcl_ZlibStream zstream = cd;
-    int command, index, count, code, buffersize = -1, flush = -1, i;
-    Tcl_Obj *obj;
-    static const char *const cmds[] = {
-	"add", "checksum", "close", "eof", "finalize", "flush",
-	"fullflush", "get", "put", "reset",
-	NULL
-    };
-    enum zlibStreamCommands {
-	zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush,
-	zs_fullflush, zs_get, zs_put, zs_reset
-    };
-    static const char *const add_options[] = {
-	"-buffer", "-finalize", "-flush", "-fullflush", NULL
-    };
-    enum addOptions {
-	ao_buffer, ao_finalize, ao_flush, ao_fullflush
-    };
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option data ?...?");
-	return TCL_ERROR;
-    }
-
-    if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "option", 0,
-	    &command) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum zlibStreamCommands) command) {
-    case zs_add:		/* $strm add ?$flushopt? $data */
-	for (i=2; i<objc-1; i++) {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
-		    &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-
-	    switch ((enum addOptions) index) {
-	    case ao_flush: /* -flush */
-		if (flush > -1) {
-		    flush = -2;
-		} else {
-		    flush = Z_SYNC_FLUSH;
-		}
-		break;
-	    case ao_fullflush: /* -fullflush */
-		if (flush > -1) {
-		    flush = -2;
-		} else {
-		    flush = Z_FULL_FLUSH;
-		}
-		break;
-	    case ao_finalize: /* -finalize */
-		if (flush > -1) {
-		    flush = -2;
-		} else {
-		    flush = Z_FINISH;
-		}
-		break;
-	    case ao_buffer: /* -buffer */
-		if (i == objc-2) {
-		    Tcl_AppendResult(interp, "\"-buffer\" option must be "
-			    "followed by integer decompression buffersize",
-			    NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
-		    return TCL_ERROR;
-		}
-		if (Tcl_GetIntFromObj(interp, objv[i+1],
-			&buffersize) != TCL_OK) {
-		    return TCL_ERROR;
-		}
-		if (buffersize < 1 || buffersize > 65536) {
-		    Tcl_AppendResult(interp,
-			    "buffer size must be 32 to 65536", NULL);
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE",
-			    NULL);
-		    return TCL_ERROR;
-		}
-	    }
-
-	    if (flush == -2) {
-		Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
-			"\"-finalize\" options are mutually exclusive", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
-		return TCL_ERROR;
-	    }
-	}
-	if (flush == -1) {
-	    flush = 0;
-	}
-
-	if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-	TclNewObj(obj);
-	code = Tcl_ZlibStreamGet(zstream, obj, buffersize);
-	if (code == TCL_OK) {
-	    Tcl_SetObjResult(interp, obj);
-	} else {
-	    TclDecrRefCount(obj);
-	}
-	return code;
-
-    case zs_put:		/* $strm put ?$flushopt? $data */
-	for (i=2; i<objc-1; i++) {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
-		    &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-
-	    switch ((enum addOptions) index) {
-	    case ao_flush: /* -flush */
-		if (flush > -1) {
-		    flush = -2;
-		} else {
-		    flush = Z_SYNC_FLUSH;
-		}
-		break;
-	    case ao_fullflush: /* -fullflush */
-		if (flush > -1) {
-		    flush = -2;
-		} else {
-		    flush = Z_FULL_FLUSH;
-		}
-		break;
-	    case ao_finalize: /* -finalize */
-		if (flush > -1) {
-		    flush = -2;
-		} else {
-		    flush = Z_FINISH;
-		}
-		break;
-	    case ao_buffer:
-		Tcl_AppendResult(interp,
-			"\"-buffer\" option not supported here", NULL);
-		return TCL_ERROR;
-	    }
-	    if (flush == -2) {
-		Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
-			"\"-finalize\" options are mutually exclusive", NULL);
-		Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
-		return TCL_ERROR;
-	    }
-	}
-	if (flush == -1) {
-	    flush = 0;
-	}
-	return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
-
-    case zs_get:		/* $strm get ?count? */
-	if (objc > 3) {
-	    Tcl_WrongNumArgs(interp, 2, objv, "?count?");
-	    return TCL_ERROR;
-	}
-
-	count = -1;
-	if (objc >= 3) {
-	    if (Tcl_GetIntFromObj(interp, objv[2], &count) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	}
-	TclNewObj(obj);
-	code = Tcl_ZlibStreamGet(zstream, obj, count);
-	if (code == TCL_OK) {
-	    Tcl_SetObjResult(interp, obj);
-	} else {
-	    TclDecrRefCount(obj);
-	}
-	return code;
-    case zs_flush:		/* $strm flush */
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	TclNewObj(obj);
-	Tcl_IncrRefCount(obj);
-	code = Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH);
-	TclDecrRefCount(obj);
-	return code;
-    case zs_fullflush:		/* $strm fullflush */
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	TclNewObj(obj);
-	Tcl_IncrRefCount(obj);
-	code = Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH);
-	TclDecrRefCount(obj);
-	return code;
-    case zs_finalize:		/* $strm finalize */
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * The flush commands slightly abuse the empty result obj as input
-	 * data.
-	 */
-
-	TclNewObj(obj);
-	Tcl_IncrRefCount(obj);
-	code = Tcl_ZlibStreamPut(zstream, obj, Z_FINISH);
-	TclDecrRefCount(obj);
-	return code;
-    case zs_close:		/* $strm close */
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	return Tcl_ZlibStreamClose(zstream);
-    case zs_eof:		/* $strm eof */
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream)));
-	return TCL_OK;
-    case zs_checksum:		/* $strm checksum */
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
-		Tcl_ZlibStreamChecksum(zstream)));
-	return TCL_OK;
-    case zs_reset:		/* $strm reset */
-	if (objc != 2) {
-	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
-	    return TCL_ERROR;
-	}
-	return Tcl_ZlibStreamReset(zstream);
-    }
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *	Set of functions to support channel stacking.
- *----------------------------------------------------------------------
- */
-
-static int
-ZlibTransformClose(
-    ClientData instanceData,
-    Tcl_Interp *interp)
-{
-    ZlibChannelData *cd = instanceData;
-    int e, result = TCL_OK;
-
-    /*
-     * Delete the support timer.
-     */
-
-    ZlibTransformTimerKill(cd);
-
-    /*
-     * Flush any data waiting to be compressed.
-     */
-
-    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
-	cd->outStream.avail_in = 0;
-	do {
-	    cd->outStream.next_out = (Bytef *) cd->outBuffer;
-	    cd->outStream.avail_out = (unsigned) cd->outAllocated;
-	    e = deflate(&cd->outStream, Z_FINISH);
-	    if (e != Z_OK && e != Z_STREAM_END) {
-		/* TODO: is this the right way to do errors on close? */
-		if (!TclInThreadExit()) {
-		    ConvertError(interp, e);
-		}
-		result = TCL_ERROR;
-		break;
-	    }
-	    if (cd->outStream.avail_out != (unsigned) cd->outAllocated) {
-		if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
-			cd->outAllocated - cd->outStream.avail_out) < 0) {
-		    /* TODO: is this the right way to do errors on close?
-		     * Note: when close is called from FinalizeIOSubsystem
-		     * then interp may be NULL */
-		    if (!TclInThreadExit()) {
-			if (interp) {
-			    Tcl_AppendResult(interp,
-				    "error while finalizing file: ",
-				    Tcl_PosixError(interp), NULL);
-			}
-		    }
-		    result = TCL_ERROR;
-		    break;
-		}
-	    }
-	} while (e != Z_STREAM_END);
-	e = deflateEnd(&cd->outStream);
-    } else {
-	e = inflateEnd(&cd->inStream);
-    }
-
-    /*
-     * Release all memory.
-     */
-
-    if (cd->inBuffer) {
-	ckfree(cd->inBuffer);
-	cd->inBuffer = NULL;
-    }
-    if (cd->outBuffer) {
-	ckfree(cd->outBuffer);
-	cd->outBuffer = NULL;
-    }
-    ckfree(cd);
-    return result;
-}
-
-static int
-ZlibTransformInput(
-    ClientData instanceData,
-    char *buf,
-    int toRead,
-    int *errorCodePtr)
-{
-    ZlibChannelData *cd = instanceData;
-    Tcl_DriverInputProc *inProc =
-	    Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
-    int e, readBytes, flush = Z_NO_FLUSH;
-
-    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
-	return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
-		errorCodePtr);
-    }
-
-    cd->inStream.next_out = (Bytef *) buf;
-    cd->inStream.avail_out = toRead;
-    if (cd->inStream.next_in == NULL) {
-	goto doReadFirst;
-    }
-    while (1) {
-	e = inflate(&cd->inStream, flush);
-	if ((e == Z_STREAM_END) || (e==Z_OK && cd->inStream.avail_out==0)) {
-	    return toRead - cd->inStream.avail_out;
-	}
-
-	/*
-	 * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
-	 *
-	 * Just indicates that the zlib couldn't consume input/produce output,
-	 * and is fixed by supplying more input.
-	 */
-
-	if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
-	    Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
-
-	    Tcl_ListObjAppendElement(NULL, errObj,
-		    Tcl_NewStringObj(cd->inStream.msg, -1));
-	    Tcl_SetChannelError(cd->parent, errObj);
-	    *errorCodePtr = EINVAL;
-	    return -1;
-	}
-
-	/*
-	 * Check if the inflate stopped early.
-	 */
-
-	if (cd->inStream.avail_in > 0) {
-	    continue;
-	}
-
-	/*
-	 * Emptied the buffer of data from the underlying channel. Get some
-	 * more.
-	 */
-
-    doReadFirst:
-	/*
-	 * Hack for Bug 2762041. Disable pre-reading of lots of input, read
-	 * only one character. This way the Z_END_OF_STREAM can be read
-	 * without triggering an EOF in the base channel. The higher input
-	 * loops in DoReadChars() would react to that by stopping, despite the
-	 * transform still having data which could be read.
-	 *
-	 * This is only a hack because other transforms may not be able to
-	 * work around the general problem in this way.
-	 */
-
-	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1);
-	if (readBytes < 0) {
-	    *errorCodePtr = Tcl_GetErrno();
-	    return -1;
-	} else if (readBytes == 0) {
-	    flush = Z_SYNC_FLUSH;
-	}
-
-	cd->inStream.next_in = (Bytef *) cd->inBuffer;
-	cd->inStream.avail_in = readBytes;
-    }
-}
-
-static int
-ZlibTransformOutput(
-    ClientData instanceData,
-    const char *buf,
-    int toWrite,
-    int *errorCodePtr)
-{
-    ZlibChannelData *cd = instanceData;
-    Tcl_DriverOutputProc *outProc =
-	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));
-    int e, produced;
-
-    if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
-	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
-		errorCodePtr);
-    }
-
-    cd->outStream.next_in = (Bytef *) buf;
-    cd->outStream.avail_in = toWrite;
-    do {
-	cd->outStream.next_out = (Bytef *) cd->outBuffer;
-	cd->outStream.avail_out = cd->outAllocated;
-
-	e = deflate(&cd->outStream, Z_NO_FLUSH);
-	produced = cd->outAllocated - cd->outStream.avail_out;
-
-	if (e == Z_OK && cd->outStream.avail_out > 0) {
-	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
-		*errorCodePtr = Tcl_GetErrno();
-		return -1;
-	    }
-	}
-    } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);
-
-    if (e != Z_OK) {
-	Tcl_SetChannelError(cd->parent,
-		Tcl_NewStringObj(cd->outStream.msg, -1));
-	*errorCodePtr = EINVAL;
-	return -1;
-    }
-
-    return toWrite - cd->outStream.avail_in;
-}
-
-static int
-ZlibTransformSetOption(			/* not used */
-    ClientData instanceData,
-    Tcl_Interp *interp,
-    const char *optionName,
-    const char *value)
-{
-    ZlibChannelData *cd = instanceData;
-    Tcl_DriverSetOptionProc *setOptionProc =
-	    Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent));
-    static const char *chanOptions = "flush";
-    int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE);
-
-    if (haveFlushOpt && optionName && strcmp(optionName, "-flush") == 0) {
-	int flushType;
-
-	if (value[0] == 'f' && strcmp(value, "full") == 0) {
-	    flushType = Z_FULL_FLUSH;
-	} else if (value[0] == 's' && strcmp(value, "sync") == 0) {
-	    flushType = Z_SYNC_FLUSH;
-	} else {
-	    Tcl_AppendResult(interp, "unknown -flush type \"", value,
-		    "\": must be full or sync", NULL);
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
-	    return TCL_ERROR;
-	}
-
-	/*
-	 * Try to actually do the flush now.
-	 */
-
-	cd->outStream.avail_in = 0;
-	while (1) {
-	    int e;
-
-	    cd->outStream.next_out = (Bytef *) cd->outBuffer;
-	    cd->outStream.avail_out = cd->outAllocated;
-
-	    e = deflate(&cd->outStream, flushType);
-	    if (e == Z_BUF_ERROR) {
-		break;
-	    } else if (e != Z_OK) {
-		ConvertError(interp, e);
-		return TCL_ERROR;
-	    } else if (cd->outStream.avail_out == 0) {
-		break;
-	    }
-
-	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
-		    cd->outStream.next_out - (Bytef*)cd->outBuffer) < 0) {
-		Tcl_AppendResult(interp, "problem flushing channel: ",
-			Tcl_PosixError(interp), NULL);
-		return TCL_ERROR;
-	    }
-	}
-	return TCL_OK;
-    }
-
-    if (setOptionProc == NULL) {
-	return Tcl_BadChannelOption(interp, optionName, chanOptions);
-    }
-
-    return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp,
-	    optionName, value);
-}
-
-static int
-ZlibTransformGetOption(
-    ClientData instanceData,
-    Tcl_Interp *interp,
-    const char *optionName,
-    Tcl_DString *dsPtr)
-{
-    ZlibChannelData *cd = instanceData;
-    Tcl_DriverGetOptionProc *getOptionProc =
-	    Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent));
-    static const char *chanOptions = "checksum header";
-
-    /*
-     * The "crc" option reports the current CRC (calculated with the Adler32
-     * or CRC32 algorithm according to the format) given the data that has
-     * been processed so far.
-     */
-
-    if (optionName == NULL || strcmp(optionName, "-checksum") == 0) {
-	uLong crc;
-	char buf[12];
-
-	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
-	    crc = cd->outStream.adler;
-	} else {
-	    crc = cd->inStream.adler;
-	}
-
-	sprintf(buf, "%lu", crc);
-	if (optionName == NULL) {
-	    Tcl_DStringAppendElement(dsPtr, "-checksum");
-	    Tcl_DStringAppendElement(dsPtr, buf);
-	} else {
-	    Tcl_DStringAppend(dsPtr, buf, -1);
-	    return TCL_OK;
-	}
-    }
-
-    /*
-     * The "header" option, which is only valid on inflating gzip channels,
-     * reports the header that has been read from the start of the stream.
-     */
-
-    if ((cd->flags & IN_HEADER) && ((optionName == NULL) ||
-	    (strcmp(optionName, "-header") == 0))) {
-	Tcl_Obj *tmpObj = Tcl_NewObj();
-
-	ExtractHeader(&cd->inHeader.header, tmpObj);
-	if (optionName == NULL) {
-	    Tcl_DStringAppendElement(dsPtr, "-header");
-	    Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj));
-	    Tcl_DecrRefCount(tmpObj);
-	} else {
-	    int len;
-	    const char *str = Tcl_GetStringFromObj(tmpObj, &len);
-
-	    Tcl_DStringAppend(dsPtr, str, len);
-	    Tcl_DecrRefCount(tmpObj);
-	    return TCL_OK;
-	}
-    }
-
-    /*
-     * Now we do the standard processing of the stream we wrapped.
-     */
-
-    if (getOptionProc) {
-	return getOptionProc(Tcl_GetChannelInstanceData(cd->parent),
-		interp, optionName, dsPtr);
-    }
-    if (optionName == NULL) {
-	return TCL_OK;
-    }
-    return Tcl_BadChannelOption(interp, optionName, chanOptions);
-}
-
-static void
-ZlibTransformWatch(
-    ClientData instanceData,
-    int mask)
-{
-    ZlibChannelData *cd = instanceData;
-    Tcl_DriverWatchProc *watchProc;
-
-    /*
-     * This code is based on the code in tclIORTrans.c
-     */
-
-    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
-    watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);
-    if (!(mask & TCL_READABLE)
-	    || (cd->inStream.avail_in == (uInt) cd->inAllocated)) {
-	ZlibTransformTimerKill(cd);
-    } else {
-	ZlibTransformTimerSetup(cd);
-    }
-}
-
-static int
-ZlibTransformGetHandle(
-    ClientData instanceData,
-    int direction,
-    ClientData *handlePtr)
-{
-    ZlibChannelData *cd = instanceData;
-
-    return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
-}
-
-static int
-ZlibTransformBlockMode(
-    ClientData instanceData,
-    int mode)
-{
-    ZlibChannelData *cd = instanceData;
-
-    if (mode == TCL_MODE_NONBLOCKING) {
-	cd->flags |= ASYNC;
-    } else {
-	cd->flags &= ~ASYNC;
-    }
-    return TCL_OK;
-}
-
-static int
-ZlibTransformHandler(
-    ClientData instanceData,
-    int interestMask)
-{
-    ZlibChannelData *cd = instanceData;
-
-    ZlibTransformTimerKill(cd);
-    return interestMask;
-}
-
-static void
-ZlibTransformTimerSetup(
-    ZlibChannelData *cd)
-{
-    if (cd->timer == NULL) {
-	cd->timer = Tcl_CreateTimerHandler(TRANSFORM_FLUSH_DELAY,
-		ZlibTransformTimerRun, cd);
-    }
-}
-
-static void
-ZlibTransformTimerKill(
-    ZlibChannelData *cd)
-{
-    if (cd->timer != NULL) {
-	Tcl_DeleteTimerHandler(cd->timer);
-	cd->timer = NULL;
-    }
-}
-
-static void
-ZlibTransformTimerRun(
-    ClientData clientData)
-{
-    ZlibChannelData *cd = clientData;
-
-    cd->timer = NULL;
-    Tcl_NotifyChannel(cd->chan, TCL_READABLE);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * ZlibStackChannelTransform --
- *
- *	Stacks either compression or decompression onto a channel.
- *
- * Results:
- *	The stacked channel, or NULL if there was an error.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_Channel
-ZlibStackChannelTransform(
-    Tcl_Interp *interp,		/* Where to write error messages. */
-    int mode,			/* Whether this is a compressing transform
-				 * (TCL_ZLIB_STREAM_DEFLATE) or a
-				 * decompressing transform
-				 * (TCL_ZLIB_STREAM_INFLATE). Note that
-				 * compressing transforms require that the
-				 * channel is writable, and decompressing
-				 * transforms require that the channel is
-				 * readable. */
-    int format,			/* One of the TCL_ZLIB_FORMAT_* values that
-				 * indicates what compressed format to allow.
-				 * TCL_ZLIB_FORMAT_AUTO is only supported for
-				 * decompressing transforms. */
-    int level,			/* What compression level to use. Ignored for
-				 * decompressing transforms. */
-    Tcl_Channel channel,	/* The channel to attach to. */
-    Tcl_Obj *gzipHeaderDictPtr)	/* A description of header to use, or NULL to
-				 * use a default. Ignored if not compressing
-				 * to produce gzip-format data. */
-{
-    ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
-    Tcl_Channel chan;
-    int wbits = 0;
-    int e;
-
-    if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
-	Tcl_Panic("unknown mode: %d", mode);
-    }
-
-    memset(cd, 0, sizeof(ZlibChannelData));
-    cd->mode = mode;
-
-    if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) {
-	if (mode == TCL_ZLIB_STREAM_DEFLATE) {
-	    if (gzipHeaderDictPtr) {
-		int dummy = 0;
-
-		cd->flags |= OUT_HEADER;
-		if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader,
-			&dummy) != TCL_OK) {
-		    goto error;
-		}
-	    }
-	} else {
-	    cd->flags |= IN_HEADER;
-	    cd->inHeader.header.name = (Bytef *)
-		    &cd->inHeader.nativeFilenameBuf;
-	    cd->inHeader.header.name_max = MAXPATHLEN - 1;
-	    cd->inHeader.header.comment = (Bytef *)
-		    &cd->inHeader.nativeCommentBuf;
-	    cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1;
-	}
-    }
-
-    if (format == TCL_ZLIB_FORMAT_RAW) {
-	wbits = WBITS_RAW;
-    } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
-	wbits = WBITS_ZLIB;
-    } else if (format == TCL_ZLIB_FORMAT_GZIP) {
-	wbits = WBITS_GZIP;
-    } else if (format == TCL_ZLIB_FORMAT_AUTO) {
-	wbits = WBITS_AUTODETECT;
-    } else {
-	Tcl_Panic("bad format: %d", format);
-    }
-
-    /*
-     * Initialize input inflater or the output deflater.
-     */
-
-    if (mode == TCL_ZLIB_STREAM_INFLATE) {
-	e = inflateInit2(&cd->inStream, wbits);
-	if (e != Z_OK) {
-	    goto error;
-	}
-	cd->inAllocated = DEFAULT_BUFFER_SIZE;
-	cd->inBuffer = ckalloc(cd->inAllocated);
-	if (cd->flags & IN_HEADER) {
-	    e = inflateGetHeader(&cd->inStream, &cd->inHeader.header);
-	    if (e != Z_OK) {
-		goto error;
-	    }
-	}
-    } else {
-	e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
-		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
-	if (e != Z_OK) {
-	    goto error;
-	}
-	cd->outAllocated = DEFAULT_BUFFER_SIZE;
-	cd->outBuffer = ckalloc(cd->outAllocated);
-	if (cd->flags & OUT_HEADER) {
-	    e = deflateSetHeader(&cd->outStream, &cd->outHeader.header);
-	    if (e != Z_OK) {
-		goto error;
-	    }
-	}
-    }
-
-    chan = Tcl_StackChannel(interp, &zlibChannelType, cd,
-	    Tcl_GetChannelMode(channel), channel);
-    if (chan == NULL) {
-	goto error;
-    }
-    cd->chan = chan;
-    cd->parent = Tcl_GetStackedChannel(chan);
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
-    return chan;
-
-  error:
-    if (cd->inBuffer) {
-	ckfree(cd->inBuffer);
-	inflateEnd(&cd->inStream);
-    }
-    if (cd->outBuffer) {
-	ckfree(cd->outBuffer);
-	deflateEnd(&cd->outStream);
-    }
-    ckfree(cd);
-    return NULL;
-}
-
-/*
- *----------------------------------------------------------------------
- *	Finally, the TclZlibInit function. Used to install the zlib API.
- *----------------------------------------------------------------------
- */
-
-int
-TclZlibInit(
-    Tcl_Interp *interp)
-{
-    /*
-     * This does two things. It creates a counter used in the creation of
-     * stream commands, and it creates the namespace that will contain those
-     * commands.
-     */
-
-    Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}");
-
-    /*
-     * Create the public scripted interface to this file's functionality.
-     */
-
-    Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *	Stubs used when a suitable zlib installation was not found during
- *	configure.
- *----------------------------------------------------------------------
- */
-
-#else /* !HAVE_ZLIB */
-int
-Tcl_ZlibStreamInit(
-    Tcl_Interp *interp,
-    int mode,
-    int format,
-    int level,
-    Tcl_Obj *dictObj,
-    Tcl_ZlibStream *zshandle)
-{
-    Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
-    Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
-    return TCL_ERROR;
-}
-
-int
-Tcl_ZlibStreamClose(
-    Tcl_ZlibStream zshandle)
-{
-    return TCL_OK;
-}
-
-int
-Tcl_ZlibStreamReset(
-    Tcl_ZlibStream zshandle)
-{
-    return TCL_OK;
-}
-
-Tcl_Obj *
-Tcl_ZlibStreamGetCommandName(
-    Tcl_ZlibStream zshandle)
-{
-    return NULL;
-}
-
-int
-Tcl_ZlibStreamEof(
-    Tcl_ZlibStream zshandle)
-{
-    return 1;
-}
-
-int
-Tcl_ZlibStreamChecksum(
-    Tcl_ZlibStream zshandle)
-{
-    return 0;
-}
-
-int
-Tcl_ZlibStreamPut(
-    Tcl_ZlibStream zshandle,
-    Tcl_Obj *data,
-    int flush)
-{
-    return TCL_OK;
-}
-
-int
-Tcl_ZlibStreamGet(
-    Tcl_ZlibStream zshandle,
-    Tcl_Obj *data,
-    int count)
-{
-    return TCL_OK;
-}
-
-int
-Tcl_ZlibDeflate(
-    Tcl_Interp *interp,
-    int format,
-    Tcl_Obj *data,
-    int level,
-    Tcl_Obj *gzipHeaderDictObj)
-{
-    Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
-    Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
-    return TCL_ERROR;
-}
-
-int
-Tcl_ZlibInflate(
-    Tcl_Interp *interp,
-    int format,
-    Tcl_Obj *data,
-    int bufferSize,
-    Tcl_Obj *gzipHeaderDictObj)
-{
-    Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
-    Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
-    return TCL_ERROR;
-}
-
-unsigned int
-Tcl_ZlibCRC32(
-    unsigned int crc,
-    const char *buf,
-    int len)
-{
-    return 0;
-}
-
-unsigned int
-Tcl_ZlibAdler32(
-    unsigned int adler,
-    const char *buf,
-    int len)
-{
-    return 0;
-}
-#endif /* HAVE_ZLIB */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tommath.h b/generic/tommath.h
deleted file mode 100644
index 028a84d..0000000
--- a/generic/tommath.h
+++ /dev/null
@@ -1 +0,0 @@
-#include "tclTomMathInt.h"